Verwenden eines Arrays für eindeutige Kopie aus mehreren Blättern/VBA

Question

Ich habe an einem Makro gearbeitet, das die Daten aus mehreren Blättern in meiner Arbeitsmappe zusammenfasst. Um zu wissen, welche Spalten ich in meinem Übersichtsblatt verwenden soll, muss ich zuerst alle eindeutigen Werte aus der ersten Spalte in meinen Blättern extrahieren.

Die Idee ist, dass es die Blätter durchlaufen und einen Bereich definieren wird, dann wird es durch jede Zelle im Bereich durchlaufen, prüfen, ob der Wert dieser Zelle bereits im Array ist und wenn nicht kopieren und einfügen und füge es dem Array hinzu.

Leider bekomme ich den Fehler "Index außerhalb des gültigen Bereichs" für die Zeile, die den Zellenwert zum Array hinzufügen soll.

ReDim Preserve uniqueVal(1 To UBound(uniqueVal) + 1) As Variant 

Ich nahm diesen spezifischen Code aus der Frage https://superuser.com/questions/808798/excel-vba-adding-an-element-to-the-end-of-an-array.

Hier ist der gesamte Code als Referenz.

Private Sub CommandButton24_Click() 

    Dim xSheet As Worksheet 
    Dim DestSh As Worksheet 
    Dim Last As Long 
    Dim copyRng As Range 
    Dim destRng As Range 
    Dim cRange As Range 
    Dim c As Range 
    Dim uniqueVal() As Variant 

    With Application 
     .ScreenUpdating = False 
     .EnableEvents = False 
    End With 

    'Delete the summary worksheet if it exists. 
    Application.DisplayAlerts = False 
    On Error Resume Next 
    ActiveWorkbook.Worksheets("Summary").Delete 
    On Error GoTo 0 
    Application.DisplayAlerts = True 

    ' Add a worksheet with the name "Summary" 
    Set DestSh = ActiveWorkbook.Worksheets.Add 
    DestSh.Name = "Summary" 
    Set destRng = DestSh.Range("A1") 

    'Define inital array values 
    uniqueVal = Array("Account by Type", "Total") 

    ' Loop through all worksheets and copy the data to the 
    ' summary worksheet. 
    For Each xSheet In ActiveWorkbook.Worksheets 

     If InStr(1, xSheet.Name, "ACCOUNT") And xSheet.Range("B1") <> "No Summary Available" Then _ 

      Set copyRng = xSheet.Range("A:A") 

      For Each c In copyRng.SpecialCells(xlCellTypeVisible) 

       If Len(c) <> 0 And Not ISIN(c, uniqueVal) Then _ 

        'Copy to destination Range 
        c.Copy destRng 
        'move destination Range 
        Set destRng = destRng.Offset(0, 1) 
        'change/adjust the size of array 
        ReDim Preserve uniqueVal(1 To UBound(uniqueVal) + 1) As Variant 
        'add value on the end of the array 
        uniqueVal(UBound(uniqueVal)) = c.Value 

       End If 

      Next c 

     End If 

    Next xSheet 

ExitTheSub: 

    Application.Goto DestSh.Cells(1) 

    With Application 
     .ScreenUpdating = True 
     .EnableEvents = True 
    End With 


End Sub 

Answer 1

Standardmäßig Arrays in Excel VBA beginnt mit dem Index 0, nicht der Index 1. Sie können dies testen, indem Sie den Inhalt Ihres Arrays überprüfen: Ihre erste Zeichenfolge "Account by Type" sollte auf uniqueval(0) statt auf uniqueval(1) sein.

Zwei Möglichkeiten, dieses Problem zu lösen:

1. Option Base 1 an Ihnen oder

2. Änderung Es ist ReDim Preserve uniqueval(1 To UBound(uniqueval) + 1) zu ReDim Preserve uniqueval(0 To UBound(uniqueval) + 1)

an die Spitze des Moduls hinzuzufügen, die ein du hast gewählt, aber letzteres ist sauberer, da du nicht mit dem Array herumspielen musst Optionen auf Modulebene.

Wie ich es sehe, verwenden Sie den Inhalt der Arrays noch nicht wirklich. Wenn Sie später tun, nur Schleife For i = LBound(uniqueval) To UBound(uniqueval) - in diesem Fall ist es irrelevant mit welcher Option Sie gingen.

Answer 2

In der ersten Schleife hat uniqueVal keinen Ubound. Deshalb schlägt es fehl. Daher sollten Sie Redim zuerst als Redim uniqueVal (1 zu 1) redigieren, dann in den Ubound schreiben und danach die Größe erhöhen. Das würde immer mit einem leeren Element an der Spitze, die Sie am Ende entfernen können. Der bessere (weil es schneller läuft) ist Dim uniqueVal auf eine mögliche maximale Anzahl, dann setzen Sie den aktuellen Index mit einem Zähler, wie i = i + 1, und machen Sie eine Redim Preserve uniqueVal (i) am Ende, wodurch schneiden Aus allen nicht verwendeten Elementen.

Der Unterstrich am Ende einer Codezeile bedeutet, dass die Zeile logisch in der nächsten Zeile fortgesetzt wird. Zum Beispiel

If 1 <> 2 Then _ 
    Debug.Print "All is well" 

Dies ist die gleiche wie If 1 <> 2 Then Debug.Print "All is well" Beachten Sie jedoch, dass es keine End If ist.Wenn es mehr als ein Befehl sollte folgt der Then Sie End If verwenden müssen, beispielsweise

If 1 <> 2 Then 
    Debug.Print "All is well" 
    A = 3 
End If 

Hier ist alles zwischen If und End If wird nur, wenn 1 <> 2 ausgeführt werden. Dies ist der Fall mit If Len(c) <> 0 And Not ISIN(c, uniqueVal) Then _. Sobald der UBound-Fehler behoben ist, wird der Code nicht mehr ausgeführt. Entfernen Sie den Unterstrich nach der Then.