VBA：跨多個工作表的列中的唯一項

Question

所以我有一個專欄，比如費用，其中包含要求支出的費用名稱。 我每個月都有這樣的清單，每個月都是一張單獨的表。 目標是將新的工作表中的唯一費用名稱列表，稍后將用於總計算。

因為我想比較不同的時期，所以要檢查的月數（工作表）是可變的，所列項目的數量也是可變的，所以我希望盡可能保持靈活性。

到目前為止我有這個代碼，但它似乎只是崩潰了。 我猜這與一些沒有價值的床單有關，但我不確定。

Sub FindExpenses()

Dim ws As Worksheet
Dim ExpenseNames As New Collection

' Find for each sheet (month)
For Each ws In ActiveWorkbook.Worksheets

    Dim itm
    Dim i As Long
    Dim CellVal As Variant

    ' Go through each row of column F looking for uniques
    For i = 2 To Rows.Count
    On Error Resume Next

        CellVal = ws.Range("F" & i).Value
        On Error Resume Next
        ExpenseNames.Add CellVal, Chr(34) & CellVal & Chr(34)
        On Error GoTo 0
    Next i

Next

' Print out to separate sheet (figure out how to)
For Each itm In ExpenseNames 
    Debug.Print itm
Next

End Sub

您能否幫我識別幾個工作表中列中的唯一項目，然后將其發送到另一個工作表中自己的列？ 任何幫助將不勝感激。 先感謝您！

Answer 1

Excel凍結，因為您在代碼中使用Rows.Count 。 因此，它會為工作簿中的每個工作表循環最多1048576 。 嘗試獲取最后使用的行並循環到它。

這是一種檢查工作表ws F列中最后一行的方法：

lastRow (ws.Name, 6)

---

Function lastRow(Optional strSheet As String, Optional columnToCheck As Long = 1) As Long

    Dim shSheet As Worksheet

    If strSheet = vbNullString Then
        Set shSheet = ActiveSheet
    Else
        Set shSheet = Worksheets(strSheet)
    End If

    lastRow = shSheet.Cells(shSheet.Rows.Count, columnToCheck).End(xlUp).Row

End Function