VBA Excel 根据先前存在填充单元格

Question

我还没有看到这个问题得到解决，但我认为这可能是因为我不知道如何简明扼要地表达我的问题。这是我想尝试做的一个例子：

给定一个包含状态首字母的列，检查输出表是否之前找到过该状态。如果还没有，则使用该状态的首字母填充一个新单元格，并将计数（已找到状态的次数）初始化为 1。如果在输出表中的单元格中找到状态的首字母，则将计数加一。

有了这个，如果我们有一个 50,000（或很多）行列的 Excel 表，其中的状态是随机顺序的（状态可能重复也可能不重复），我们将能够创建一个干净的表，输出哪些状态在原始数据表以及它们出现的次数。考虑这一点的另一种方法是编写数据透视表，但信息较少。

我想了几种方法来完成这个，我个人认为这些都不是很好的想法，但我们会看到。

算法 1，所有 50 个状态：

1. 为每个状态创建 50 个字符串变量，为计数创建 50 个长变量
2. 循环遍历原始数据表，如果找到特定状态，则增加适当的计数（这需要 50 个 if-else 语句）
3. 输出结果

总体......糟糕的想法

算法2，触发器：

1. 不要创建任何变量
2. 如果在原始数据表中找到状态，请查看输出表以检查之前是否已找到状态
3. 如果之前已经找到状态，则将相邻单元格加一
4. 如果之前没有找到状态，将下一个可用的空白单元格更改为状态首字母并初始化相邻的单元格
5. 返回原始数据表

总体而言......这可以工作，但我觉得这似乎需要很长时间，即使原始数据表不是很大，但它的好处是不会像 50 状态算法那样浪费内存并且更少代码行

附带说明，是否可以在不激活该工作簿的情况下访问工作簿（或工作表）的单元格？我问是因为它会使第二种算法运行得更快。

谢谢，

杰西·斯莫莫

Answer 1

可以加快代码速度的几点：

1. 您无需激活工作簿、工作表或范围即可访问它们 例如

   DIM wb as workbook  
   DIM ws as worksheet  
   DIM rng as range
   
   Set wb = Workbooks.OpenText(Filename:=filePath, Tab:=True) ' or Workbooks("BookName")  
   Set ws = wb.Sheets("SheetName")  
   Set rng = ws.UsedRange ' or ws.[A1:B2], or many other ways of specifying a range  
   

您现在可以像

一样参考工作簿/工作表/范围

rng.copy
for each  cl in rng.cells
etc

1. 循环遍历单元格非常很慢。首先将数据复制到变体数组，然后循环遍历数组，速度要快得多。此外，在工作表上创建大量数据时，最好先在变量数组中创建它，然后一次性将其复制到工作表中。

   DIM v As Variant
   v = rng
   

例如，如果 rng 指的是 10 行 x 5 列的范围，则 v 变成了一个 1 到 10、1 到 5 的数组。您提到的 5 分钟可能最多会减少到几秒

Answer 2

   Sub CountStates()
     Dim shtRaw As Excel.Worksheet
     Dim r As Long, nr As Long
     Dim dict As Object
     Dim vals, t, k

    Set dict = CreateObject("scripting.dictionary")
    Set shtRaw = ThisWorkbook.Sheets("Raw")
    vals = Range(shtRaw.Range("C2"), _
                 shtRaw.Cells(shtRaw.Rows.Count, "C").End(xlUp)).Value
    nr = UBound(vals, 1)

    For r = 1 To nr
        t = Trim(vals(r, 1))
        If Len(t) = 0 Then t = "Empty"
        dict(t) = dict(t) + 1
    Next r

    For Each k In dict.keys
        Debug.Print k, dict(k)
    Next k
End Sub

Answer 3

我实现了我的第二个算法，看看它是如何工作的。代码在下面，我确实在实际问题中省略了一些细节，以尝试更清楚地解决核心问题，对此感到抱歉。通过下面的代码，我添加了其他“部分”。

代码：

' this number refers to the raw data sheet that has just been activated
totalRow = ActiveSheet.Range("A1").End(xlDown).Row
    For iRow = 2 To totalRow
        ' These are specific to the company needs, refers to addresses
        If (ActiveSheet.Cells(iRow, 2) = "BA") Then
            badAddress = badAddress + 1
        ElseIf (ActiveSheet.Cells(iRow, 2) = "C") Then
            coverageNoListing = coverageNoListing + 1
        ElseIf (ActiveSheet.Cells(iRow, 2) = "L") Then
            activeListing = activeListing + 1
        ElseIf (ActiveSheet.Cells(iRow, 2) = "NC") Then
            noCoverageNoListing = noCoverageNoListing + 1
        ElseIf (ActiveSheet.Cells(iRow, 2) = "NL") Then
            inactiveListing = inactiveListing + 1
        ElseIf (ActiveSheet.Cells(iRow, 2) = "") Then
            noHit = noHit + 1
        End If
        ' Algorithm beginning
        ' If the current cell (in state column) has something in it
        If (ActiveSheet.Cells(iRow, 10) <> "") Then
            ' Save value into a string variable
            tempState = ActiveSheet.Cells(iRow, 10)
            ' If this is also in a billable address make variable true
            If (ActiveSheet.Cells(iRow, 2) = "C") Or (ActiveSheet.Cells(iRow, 2) = "L") Or (ActiveSheet.Cells(iRow, 2) = "NL") Then
                boolStateBillable = True
            End If
            ' Output sheet
            BillableWorkbook.Activate
            For tRow = 2 To endOfState
                ' If the current cell is the state
                If (ActiveSheet.Cells(tRow, 9) = tempState) Then
                    ' Get the current hit count of that state
                    tempStateTotal = ActiveSheet.Cells(tRow, 12)
                    ' Increment the hit count by one
                    ActiveSheet.Cells(tRow, 12) = tempStateTotal + 1
                    ' If the address was billable then increment billable count
                    If (boolStateBillable = True) Then
                        tempStateBillable = ActiveSheet.Cells(tRow, 11)
                        ActiveSheet.Cells(tRow, 11) = tempStateBillable + 1
                    End If
                    Exit For
                ' If the tempState is unique to the column
                ElseIf (tRow = endOfState) Then
                    ' Set state, totalCount
                    ActiveSheet.Cells(tRow - 1, 9) = tempState
                    ActiveSheet.Cells(tRow - 1, 12) = 1
                    ' Increment the ending point of the column
                    endOfState = endOfState + 1
                    ' If it's billable, indicate with number
                    If (boolStateBillable = True) Then
                        tempStateBillable = ActiveSheet.Cells(tRow - 1, 11)
                        ActiveSheet.Cells(tRow - 1, 11) = tempStateBillable + 1
                    End If
                End If
            Next
        ' Activate raw data workbook
        TextFileWorkbook.Activate
        ' reset boolean
        boolStateBillable = False
    Next

我运行过一次，它似乎奏效了。问题是大约花了五分钟左右，原始代码需要 0.2（粗略猜测）。我认为使代码执行得更快的唯一方法是不能一遍又一遍地激活这两个工作簿。这意味着答案不完整，但如果我弄清楚其余部分，我会编辑。

注意我将重新审视数据透视表，看看我是否可以在其中做我需要做的所有事情，截至目前看来，有几件事我无法做到改变，但我会检查

谢谢，

杰西·斯莫莫

Answer 4

我坚持使用第二种算法。我忘记了字典选项，但我仍然对它的工作方式不太满意，而且我通常还不太了解它。我玩了一会儿代码，做了一些修改，现在运行得更快了。

代码：

' In output workbook (separate sheet)
Sheets.Add.Name = "Temp_Text_File"

' Opens up raw data workbook (originally text file
Application.DisplayAlerts = False
Workbooks.OpenText Filename:=filePath, Tab:=True
Application.DisplayAlerts = True
Set TextFileWorkbook = ActiveWorkbook
totalRow = ActiveSheet.Range("A1").End(xlDown).Row
' Copy all contents of raw data workbook
Cells.Select
Selection.Copy

BillableWorkbook.Activate

' Paste raw data into "Temp_Text_File" sheet
Range("A1").Select
ActiveSheet.Paste

ActiveWorkbook.Sheets("Billable_PDF").Select

' Populate long variables
For iRow = 2 To totalRow
    If (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "BA") Then
        badAddress = badAddress + 1
    ElseIf (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "C") Then
        coverageNoListing = coverageNoListing + 1
    ElseIf (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "L") Then
        activeListing = activeListing + 1
    ElseIf (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "NC") Then
        noCoverageNoListing = noCoverageNoListing + 1
    ElseIf (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "NL") Then
        inactiveListing = inactiveListing + 1
    ElseIf (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "") Then
        noHit = noHit + 1
    End If
    If (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 10) <> "") Then
        tempState = ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 10)
        If (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "C") Or (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "L") Or (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "NL") Then
            boolStateBillable = True
        End If
        'BillableWorkbook.Activate
        For tRow = 2 To endOfState
            If (ActiveSheet.Cells(tRow, 9) = tempState) Then
                tempStateTotal = ActiveSheet.Cells(tRow, 12)
                ActiveSheet.Cells(tRow, 12) = tempStateTotal + 1
                If (boolStateBillable = True) Then
                    tempStateBillable = ActiveSheet.Cells(tRow, 11)
                    ActiveSheet.Cells(tRow, 11) = tempStateBillable + 1
                End If
                Exit For
            ElseIf (tRow = endOfState) Then
                ActiveSheet.Cells(tRow, 9) = tempState
                ActiveSheet.Cells(tRow, 12) = 1
                endOfState = endOfState + 1
                If (boolStateBillable = True) Then
                    tempStateBillable = ActiveSheet.Cells(tRow, 11)
                    ActiveSheet.Cells(tRow, 11) = tempStateBillable + 1
                End If
            End If
        Next
        'stateOneTotal = stateOneTotal + 1
        'If (ActiveSheet.Cells(iRow, 2) = "C") Or (ActiveSheet.Cells(iRow, 2) = "L") Or (ActiveSheet.Cells(iRow, 2) = "NL") Then
        '    stateOneBillable = stateOneBillable + 1
        'End If
    'ElseIf (ActiveSheet.Cells(iRow, 10) = "FL") Then
        'stateTwoTotal = stateTwoTotal + 1
        'If (ActiveSheet.Cells(iRow, 2) = "C") Or (ActiveSheet.Cells(iRow, 2) = "L") Or (ActiveSheet.Cells(iRow, 2) = "NL") Then
        '    stateTwoBillable = stateTwoBillable + 1
        'End If
    End If
    'TextFileWorkbook.Activate
    If (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "C") Or (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "L") Or (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "NL") Then
        billableCount = billableCount + 1
    End If
    boolStateBillable = False
Next

' Close raw data workbook and raw data worksheet
Application.DisplayAlerts = False
TextFileWorkbook.Close
ActiveWorkbook.Sheets("Temp_Text_File").Delete
Application.DisplayAlerts = True

感谢您的 cmets 和建议。一如既往地非常感谢。

杰西·斯莫莫