Office: (Office 2013) Listenfeld mit Verbundenen Zellen

Hallo Zusammen,

habe mir einen Code mit Hilfe aus einem Video geschrieben.
Hier soll wenn in eine Zelle in dem Bereich Stoerungen_ eine Listbox auftauchen und den Ausgewählten Störgrund einfügen.

Das Funktioniert aus soweit in nicht verbundenen Zellen.

Leider ist es so, das in der Datei in welche ich das einsetzen möchte diese Zellen verbundene sind.
Es ist auch nicht mehr möglich dass zu ändern.

Eventuell kann sich mal jemand den Code ansehen und mir eine Lösung nennen oder Tipps.

Datei ist dabei.

 

Hi,

da musst du dich auch nicht wundern, denn mit der Zeile

Code:

If Target.Count > 1 Then Exit Sub

erzwingst du einen Codeabbruch, wenn mehr als 1 Zelle ausgewählt wurde - was jedoch bei verbundenen Zellen der Fall ist. Versuche es mal mit folgendem Code:

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    'Prüfen ob die 1. Zelle der selektierten Zellen innerhalb des Bereichs liegt
    If Not Intersect(Target.Cells(1), Range("Stoerungen_")) Is Nothing Then UfStoerungen.Show
End Sub

---

 

Hallo,

habe dir ein paar Änderungen eingefügt.

 

Halo Zusammen,

danke für die schnelle Hilfe. Leider habe ich etwas wichtiges vergessen zu schreiben.
Es sollte so sein das ich vor jeder Minutenangabe eine andere Störmeldung angeben möchte .

Sorry

 

Hallo Merkur,

beiliegend die Änderung gemäß deinen Wünschen.

 

Hallo Anton,

klappt wunderbar. An dem Problem habe ich schon lange Zeit rum gebastelt.

Herzlichen Dank für die Hilfe.

 

Guten Morgen,
ich habe den Code und die Userform in meine Hauptdatei eingebaut. Leider bekomme ich nun den Fehler Laufzeitfehler 9 ,Index außerhalb des gültigen Bereichs.

Würde aus Datenschutz Gründen die Hauptdatei ungerne hier hochladen.
Daher habe ich ein paar Bilder hinzugefügt. Eventuell kann ich die Datei an Dich senden wenn es mit der Lösung nichts wird ?

 

Guten Abend,
habe jetzt doch meine Problem Datei hochgeladen.
In der Datei von Anton funktioniert alles Super.
Wenn ich alles in meine Datei einbaue bekomme ich den Laufzeitfehler 9 sobald ich in eine der Zellen klicke die mit "Stoerungen_" benannt sind.

Code:

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If Target.Count <> 2 Then Exit Sub
   'Prüfen ob wir in der Zelle sind
   If Not Intersect(Target, Range("Stoerungen_")) Is Nothing Then UfStoerungen.Show
End Sub

Habe alles versucht was im Rahmen meiner Kenntnis ist. Klappt aber nicht.

Danke

 

Hi,

der Fehler kommt nicht in der von dir geposteten Prozedur des SelectionChange-Ereignisses sondern in dieser:

Code:

Private Sub UserForm_Initialize()
    Dim lstO As ListObject
    'ListBox befüllen
    Set lstO = Worksheets("Daten").ListObjects("tbStoerungen")  '<== tbStoerungen wird nicht gefunden!!
    lbStoerungen.List = lstO.ListColumns("Störungen").DataBodyRange.Value
End Sub

Ändere tbStoerungen in Tabelle4, dann gibt es keinen Laufzeitfehler.

---

 

Hallo Karin,

danke für die Lösung. Funktioniert nun .

Klasse.

Gute Nacht

 

Hallo,

könnte man das auch so erweitern wenn man einen Monat in einem Blatt hat und die Störgründe an jeden Tag auswählen kann?

Habe es über den Namensmanager versucht doch die Formel mit den ganzen Zellen ist dafür zu lang.

 

Hi,

dann musst du den Bereich der Wirksamkeit per VBA zusammensetzen. Dazu in einem Standardmodul folgenden Code:

Code:

Option Explicit
Public blnBereich As Boolean 'Variable zum Prüfen ob Bereich bereits zusammengefasst wurde
Public rngBereich As Range   'Variable für den zusammengefassten Bereich

und im Codemodul des Tabellenblattes diesen Code:

Code:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rngSuche As Range
    Dim strStart As String
    ' Bereiche nur einmalig zusammenfassen, danach das Zusammenfassen überspringen
    If blnBereich = False Then
        ' Bedingung für das Verlassen der Prozedur unterschiedlich je nach Spalte der 1. Zelle der Markierung
        Select Case Target.Cells(1).Column
            Case 3, 12, 21
                If Target.Count > 2 Then Exit Sub
            Case 5, 14, 23
                If Target.Count > 3 Then Exit Sub
        End Select
        '  1. Zelle mit dem Inhalt "Grund" im benutzten Bereich der Tabelle suchen
        Set rngSuche = ActiveSheet.UsedRange.Find("Grund", lookat:=xlPart, LookIn:=xlValues)
        ' 1. Zelle wurde gefunden
        If Not rngSuche Is Nothing Then
            ' Zelladresse der 1. gefundenen Zelle auf Variable schreiben
            strStart = rngSuche.Address
            Do
                ' Variable ist noch leer
                If rngBereich Is Nothing Then
                    ' Bereich aller Zellen 1 Zeile unterhalb bis 8 Zeilen unterhalb auf Variable schreiben
                    Set rngBereich = Range(rngSuche.Offset(1, 0).Address, rngSuche.Offset(8, 0).Address)
                Else
                    ' nächsten Bereich hinzufügen
                    Set rngBereich = Union(rngBereich, Range(rngSuche.Offset(1, 0).Address, rngSuche.Offset(8, 0).Address))
                End If
                ' nächste Zelle suchen
                Set rngSuche = ActiveSheet.UsedRange.FindNext(rngSuche)
            ' Schleife so lange ausführen wie Adresse der gefundenen Zelle <> Adresse der Startzelle
            Loop While rngSuche.Address <> strStart
            ' Variable nach dem Zusammenfassen auf True, damit das Zusammenfassen nicht jedesmal ausgeführt wird
            blnBereich = True
        End If
    End If
    'Prüfen ob wir in der Zelle sind
    If Not Intersect(Target, rngBereich) Is Nothing Then UfStoerungen.Show
End Sub

Ich habe den Code mit Kommentaren versehen, damit du verstehst, was abläuft. Falls du Fragen hast - einfach fragen.

---

 

Hallo Karin,

der Code funktioniert ohne Probleme. Danke für die Kommentare.
Danke Dir herzlich für Deine Hilfe. Das ist nicht selbstverständlich.

Ein schönes Wochenende .