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

我还没有看到这个问题，但我想这可能是因为我不知道如何简明地表达我的问题。下面是我想尝试做的一个例子:

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

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

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

算法1，所有50个州:

为每个状态创建50个字符串变量，为计数创建50个长变量
循环遍历原始数据表，如果发现特定状态，则增加适当的计数(这将需要50个if-else语句)
输出结果

整体…可怕的主意

算法2，触发器:

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

整体…这可以工作，但我觉得如果它需要永远，即使原始数据表不是很大，但它有不浪费内存的好处像50状态算法和更少的代码行

附带说明，是否有可能在不激活工作簿的情况下访问工作簿(或工作表)的单元格?我问这个问题是因为它会使第二个算法运行得更快。

谢谢你,杰西Smothermon

提高代码速度的几个要点:

您不需要激活工作簿、工作表或区域来访问它们如

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

循环通过细胞非常慢。首先将数据复制到一个变量数组，然后循环遍历该数组，这样要快得多。此外，当在工作表上创建大量数据时，最好先在变体数组中创建数据，然后将其一次性复制到工作表中。
```
DIM v As Variant
v = rng
```

例如，如果RNG引用一个10行乘5列的范围，则v成为一个dim 1到10,1到5的数组。你说的5分钟可能最多缩短为几秒

   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

我实现了第二个算法，看看它是如何工作的。代码在下面，我在实际问题中省略了一些细节，试图更清楚地了解核心问题，抱歉。使用下面的代码，我添加了其他"部分"。

代码:

' 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

我运行了一次，它似乎已经工作了。问题是它大约花了5分钟左右，而原始代码只花了0.2分钟(粗略估计)。我认为使代码执行更快的唯一方法是以某种方式不能一遍又一遍地激活两个工作簿。这意味着答案不完整，但如果我弄清楚其余的，我会编辑。

注意我将重新访问数据透视表，看看我是否可以在其中做我需要做的一切，到目前为止，看起来有一些事情我无法改变，但我会检查

谢谢你,杰西Smothermon

我继续使用第二种算法。还有一个字典选项，我忘记了，但我仍然不太熟悉它的工作方式，而且我还不太了解它。我玩了一下代码，改变了一些东西，它现在工作得更快了。

代码:

' 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

谢谢你的意见和建议。如往常一样，非常感谢。

杰西Smothermon

相关内容

最新更新

热门标签：