VBA Excel基于以前的存在填充单元格

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

给定一个保存状态首字母的列检查输出表，如果之前已经发现状态。 如果它没有，那么用这个状态的首字母填充一个新的单元格，并将count（发现状态的次数）初始化为1。 如果在输出表单元格中find状态的首字母缩写，则将计数增加1。

有了这个，如果我们有一个以随机顺序（状态可能会重复或不可重复）的5万（或多个）内联Excel表格，我们将能够创build一个干净的表格，输出原始数据表中的哪些状态和他们出现了多less次 另一种思考方式是编写一个数据透视表，但信息较less。

我曾经想过如何完成这个方法，我个人认为这些都不是很好的想法，但我们会看到。

algorithm1，全部50个状态：

  1. 为每个状态创build50个stringvariables，为计数创build50个长variables
  2. 循环访问原始数据表，如果find特定状态，则增加适当的计数（这将需要50个if-else语句）
  3. 输出结果

整体…..可怕的想法

algorithm2，触发器：

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

总体来说…..这可能工作，但我觉得好像它会花费永远，即使原始数据表不是很大，但它的优点是不浪费50状态algorithm的内存和更less的代码行

在附注中，是否可以在不激活工作簿的情况下访问工作簿（或工作表）的单元格？ 我问，因为这会使第二个algorithm运行得更快。

谢谢，

Jesse Smothermon

几点会加快你的代码：

  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. 循环通过细胞是非常缓慢的。 将数据首先复制到变体数组的速度要快得多，然后遍历数组。 另外，在工作表上创build大量数据时，最好先在不同的数组中创build数据，然后将其复制到工作表中。 

     DIM v As Variant v = rng

例如，如果rng表示10行乘5列的范围，则v变成暗淡1至10,1至5的arrays。您提及的5分钟可能会最多减less至秒 

  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

我实现了我的第二个algorithm，看看它是如何工作的。 代码如下，我没有在实际的问题上留下一些细节，试图更清楚地了解核心问题，对此感到遗憾。 通过下面的代码，我添加了其他“部分”。

码： 

 ' 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（粗略猜测）。 我认为让代码更快执行的唯一方法是以某种方式不能反复激活两个工作簿。 这意味着答案是不完整的，但如果我找出其他答案，我会编辑。

请注意，我将重新审视数据透视表，看看我是否可以做所有我需要的内容，到目前为止，看起来有几件事我不能改变，但我会检查

谢谢，

Jesse Smothermon

我保持与第二个algorithm。 有字典选项，我忘了，但我仍然不是很舒服，它的工作原理，我一般还不明白。 我玩了一下代码，并改变了一些东西，现在它运行得更快。

码： 

 ' 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

感谢您的意见和build议。 非常感谢，一如既往。

Jesse Smothermon

Interesting Posts