Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema ListBox
BildScreenshot zu ListBox ListBox-Seite mit Beispielarbeitsmappe aufrufen

Problem mit dem Neudimensionieren eines Arrays

Betrifft: Problem mit dem Neudimensionieren eines Arrays von: Kasimir
Geschrieben am: 06.11.2014 18:19:47

Hallo an alle Helfer!
Ich habe mal wieder ein Problem. Ich habe folgenden VBA-Code:

Private Sub CommandButton2_Click()
Dim rngSuchbereich      As Range

Dim intColumTherapeut   As Integer

Dim lngTermine          As Long

Dim strTermin()         As String
Dim strKasse()          As String
Dim Therapie1()         As String
Dim Therapie2()         As String
Dim Therapie3()         As String
Dim strAddresse         As String
Dim strColumn           As String

Dim arr()               As String

Dim lngEinträge         As Long

With Termine
    'Suchen, in welcher Zeile die Überschriften stehen. Kriterium ist die Überschrift " _
Artikelnummer"
    Set rngSuchbereich = Termine.Columns("D:W").Find(What:=ComboBox1, LookIn:=xlFormulas,  _
LookAt:=xlPart, MatchCase:=True)
    If Not rngSuchbereich Is Nothing Then
        lngTermine = rngSuchbereich.Row
        strAddresse = rngSuchbereich.Address
        
        Do

        lngEinträge = lngEinträge + 1
        
        strColumn = rngSuchbereich.Column
        
        strTermin = Split(Termine.Cells(rngSuchbereich.Row, rngSuchbereich.Column), "-")
        
        On Error Resume Next
        Therapie1 = Split(strTermin(2), ":")
        On Error GoTo 0
        
        On Error Resume Next
        Therapie2 = Split(strTermin(3), ":")
        On Error GoTo 0
        
        On Error Resume Next
        Therapie3 = Split(strTermin(4), ":")
        On Error GoTo 0
        
        Select Case strColumn
        
            Case 4
                intColumTherapeut = 2
            
            Case 7
                intColumTherapeut = 4
                
            Case 10
                intColumTherapeut = 6
            
            Case 13
                intColumTherapeut = 8
            
            Case 16
                intColumTherapeut = 10
            
            Case 19
                intColumTherapeut = 12
        
            Case 22
                intColumTherapeut = 14
            
            Case 25
                intColumTherapeut = 16
            
            Case 28
                intColumTherapeut = 18
            
            Case 31
                intColumTherapeut = 20
        End Select

        ReDim arr(1 To 6, 1 To lngEinträge)
        
        arr(1, lngEinträge) = Termine.Cells(rngSuchbereich.Row, 2)
        arr(2, lngEinträge) = Format(Termine.Cells(rngSuchbereich.Row, 3), "hh:mm")
        arr(3, lngEinträge) = Cells(2, intColumTherapeut)
            'Wenn 3 Therapien eingetragen
        If Therapie1(1) > "" And Therapie2(1) > "" And Therapie3(1) > "" Then
            arr(4, lngEinträge) = Mid(Therapie1(1), 1, Len(Therapie1(1)) - 1) & ", "
            arr(5, lngEinträge) = Mid(Therapie2(1), 1, Len(Therapie2(1)) - 1) & ", "
            arr(6, lngEinträge) = Mid(Therapie3(1), 1, Len(Therapie3(1)) - 1)
        'Wenn 2 Therapien eingetragen
        ElseIf Therapie1(1) > "" And Therapie2(1) > "" Then
            arr(4, lngEinträge) = Mid(Therapie1(1), 1, Len(Therapie1(1)) - 1) & ", "
            arr(5, lngEinträge) = Mid(Therapie2(1), 1, Len(Therapie2(1)) - 1) & ", "
        'Wenn 1 Therapie eingetragen
        ElseIf Therapie1(1) > "" Then
            arr(4, lngEinträge) = Mid(Therapie1(1), 1, Len(Therapie1(1)) - 1) & ", "
        End If

        Set rngSuchbereich = Termine.Columns("D:W").FindNext(rngSuchbereich)
        Loop While Not rngSuchbereich Is Nothing And rngSuchbereich.Address <> strAddresse

    End If

End With

With ListBox1
    .Clear
    .ColumnCount = 6
    .ColumnWidths = "2cm; 1,5cm; 3cm; 1cm; 1cm; 1cm"
    .List() = WorksheetFunction.Transpose(arr)
End With

End Sub
Damit durchsuche ich ein Tabellenblatt nach einem Namen. Die Daten des gefundenen Namens werden in ein Array geschrieben. Da ich am Anfang noch nicht weiß, wieviele Einträge das Array haben wird, dimensioniere ich es bei jedem Fund neu. Am Ende lasse ich über die Transponse-Funktion die Daten in eine ListBox eintragen. Leider wird mir nur der letzte Eintrag des Arrays angezeigt. Davor sind nur leere Zeilen in der ListBox und ich weiß aber nicht warum. Daher meine Frage: Kann mal jemand über den VBA-Code schauen ob ich irgendwo einen Fehler gemacht habe?

Danke Euch,
Kasimir

  

Betrifft: AW: Problem mit dem Neudimensionieren eines Arrays von: Hajo_Zi
Geschrieben am: 06.11.2014 18:22:27

Hallo Kasimir,

Du möchtest die alten Werte im Array bestimmt erhalten.
ReDim Preserve arr

GrußformelHomepage


  

Betrifft: AW: Problem mit dem Neudimensionieren eines Arrays von: Kasimir
Geschrieben am: 06.11.2014 18:25:48

Hallo Hajo!

Na das ging ja man fix. ;-) Danke Dir für die Antwort. Genau das war das Problem.

Noch einen schönen Abend,
Kasimir


 

Beiträge aus den Excel-Beispielen zum Thema "Problem mit dem Neudimensionieren eines Arrays"