benötige Hilfe beim Code für ein UserForm (VBA)

[LRJenni]

Hallo zusammen, 

ich bin am verzweifeln. 

Ich versuche eine Userform zu erstellen, welche die eingegebenen Daten in vorgegebene Spalten einfügt. 

Ich habe es soweit hinbekommen, dass beim Öffnen des Formulars die Felder wie gewünscht aus dem Tabellenblat "Data" initialisiert werden und die Auswahl für den User vorgegeben ist. 
Lediglich der Command Button "Eingabe" will noch nicht so ganz funktionieren. 

Im Formular sind 4 Textfelder, sowie 4 Listenfelder. 
Der Teil mit den Textfeldern funktioniert. Wenn ich den Code Abschnitt der Listenfelder rausnehme, werden die Ergebnisse wie gewünscht im Tabellenblatt "Liste" eingefügt. 
Lediglich der Teil mit den Listenfeldern möchte nicht so richtig und mir fehlt hier definitiv das Fachwissen um dies zu lösen. 

Wenn dieser enthalten ist, erhalte ich die Meldung "Fehler beim Kompilieren: Variable nicht definiert" Ich kommer hier nicht weiter, da ich nicht drauf komme, wo hier noch eine Definition fehlt... 

Kann mir hier eventuell jemand mit helfen? 

Ich habe die Datei mal angehangen. 
  BERLIN_CXL Policy Override Template_BKG.xlsm (Größe: 40,66 KB / Downloads: 5)

Danke vorab und einen schönen Restsonntag, 
LJ

[snb]

Zum Anfang
Lösche alle 'merged Cells'

Code:

Private Sub UserForm_Initialize()
    sn = Sheets("Data").Cells(1).CurrentRegion.Offset(1)
   
    For jj = 1 To 2
      Me(Choose(jj, "tbHotelID", "tbHotelName")) = sn(1, jj)
    Next
    For jj = 1 To 4
      Me(Choose(jj, "lbcurrentpolicy", "lbnewpolicy", "lbrateplans", "lbroomtypes")).List = Application.Index(sn, 0, jj + 4 - (jj > 2))
    Next
End Sub

Und weiter:

Code:

Private Sub cmdbEingabe_Click()
    ReDim sn(1)
    For j = 0 To 10
      If j < lbroomtypes.ListCount Then If lbroomtypes.Selected(j) Then sn(0) = sn(0) & ", " & lbroomtypes.List(j)
      If j < lbrateplans.ListCount Then If lbrateplans.Selected(j) Then sn(1) = sn(1) & ", " & lbrateplans.List(j)
    Next
    
    Sheets("List").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 9) = Array(tbHotelID, tbHotelName, tbstartdate, tbenddate, lbcurrentpolicy, lbnewpolicy, , Mid(sn(0), 2), Mid(sn(1), 2))
End Sub

[Egon12]

Hallo,

- die Listboxen sind auf Multiselect gesetzt und du wertest in einer Schleife alle markierten Einträge aus. Übergeben wird aber so nur der letzte Wert. Man muss das eben sammeln.
- Die Variable i ist nicht dimensioniert, was bei Anwendung von Option Explicit unabdingbar gemacht werden muss.
- Next i fehlt am Ende der Prozedur
Da ich nicht weiß, was du mit den getrennten Stringvariblen noch vor hast, habe ich die erst mal drin gelassen und zum Sammeln der Markierten benutzt.

Dann wäre die Prozedur mit Auswertung des Multiselct dann so:

Code:

Private Sub cmdbEingabe_Click()
    Dim nextRow&, i&
    Dim selectedCurrentPolicy$, selectedNewPolicy$, selectedRates$, selectedRoomTypes$
    nextRow = Worksheets("List").Cells(Rows.Count, 1).End(xlUp).Row + 1
   
    With Worksheets("List")
        .Cells(nextRow, 1) = tbHotelID.Value
        .Cells(nextRow, 2) = tbHotelName.Value
        .Cells(nextRow, 3) = tbstartdate.Value
        .Cells(nextRow, 4) = tbenddate.Value

        selectedCurrentPolicy = ""
        selectedNewPolicy = ""
        selectedRates = ""
        selectedRoomTypes = ""

        For i = 0 To lbcurrentpolicy.ListCount - 1
            If lbcurrentpolicy.Selected(i) Then
                .Cells(nextRow, 5) = lbcurrentpolicy.List(i)
            End If
        Next i
        For i = 0 To lbnewpolicy.ListCount - 1
            If lbnewpolicy.Selected(i) Then
                .Cells(nextRow, 6) = lbnewpolicy.List(i)
            End If
        Next i
        For i = 0 To lbroomtypes.ListCount - 1
            If lbroomtypes.Selected(i) Then
                selectedRoomTypes = selectedRoomTypes & lbroomtypes.List(i) & ", "
                .Cells(nextRow, 9) = lbroomtypes.List(i)
            End If
        Next i
        .Cells(nextRow, 9) = selectedRoomTypes
       
        For i = 0 To lbrateplans.ListCount - 1
            If lbrateplans.Selected(i) Then
                selectedRates = selectedRates & lbrateplans.List(i) & ", "
            End If
        Next i
        .Cells(nextRow, 8) = selectedRates
    End With
End Sub

Die Rahmen der Tabelle kann man mit bedingter Formatierung anzeigen lassen.

Gruß Uwe

[LRJenni]

Hallo zusammen, 

ich danke euch sehr! Das hilft ungemein! 

Viele Grüße, 
LJ