Question

我已经在这里发布了一个代码并插入了一个If语句，它基本上使表单保存每10,000个循环。我在某个地方读到了一个建议，即停止完全崩溃。我基本上试图匹配列并通过突出显示/复制来查找重复项。

问题是我要比较的两列各有10万行。我现在已经运行了4个小时的代码，它只生产了1000行匹配...我期待至少15,000场比赛。

这段时间的惩罚变得荒谬，我很确定有更快的方法，但我不是编码方面的专家。：（

Sub Compare()


Dim Report As Worksheet
Dim i, j, z, colNum, vMatch As Integer
Dim lastRowA, lastRowB, lastRow, lastColumn As Integer
Dim ColumnUsage As String
Dim colA, colB, colC As String
Dim A, B, C As Variant

Set Report = Excel.ActiveSheet
vMatch = 1

'Select A and B Columns to compare
On Error Resume Next
 Set A = Application.InputBox(Prompt:="Select column to compare",        Title:="Column A", Type:=8)
       If A Is Nothing Then Exit Sub
    colA = Split(A(1).Address(1, 0), "$")(0)
     Set B = Application.InputBox(Prompt:="Select column being searched",     Title:="Column B", Type:=8)
   If A Is Nothing Then Exit Sub
  colB = Split(B(1).Address(1, 0), "$")(0)
 'Select Column to show results
     Set C = Application.InputBox("Select column  to show results", "Results", Type:=8)
    If C Is Nothing Then Exit Sub
  colC = Split(C(1).Address(1, 0), "$")(0)

'Get Last Row
lastRowA = Report.Cells.Find("", Range(colA & 1), xlFormulas, xlByRows,      xlPrevious).row - 1 ' Last row in column A
lastRowB = Report.Cells.Find("", Range(colB & 1), xlFormulas, xlByRows, xlPrevious).row - 1 ' Last row in column B

 Application.ScreenUpdating = False
'***************************************************
For i = 3 To lastRowA     'change this NUMBER depending on which row the data starts
      For j = 3 To lastRowB
           z = j / 10000
          If Report.Cells(i, A.Column).Value <> "" Then
              If InStr(1, Report.Cells(j, B.Column).Value, Report.Cells(i, A.Column).Value, vbTextCompare) > 0 Then
                  vMatch = vMatch + 1
                  Report.Cells(i, A.Column).Interior.ColorIndex = 35 'Light green background
                  Range(colC & 1).Value = "Items Found"
                  Report.Cells(i, A.Column).Copy Destination:=Range(colC & vMatch)
                        If j = Int(j) Then
                            ThisWorkbook.Save
                  Exit For
              Else
                  'Do Nothing
              End If
            End If
          End If
      Next j
  Next i
If vMatch = 1 Then
    MsgBox Prompt:="No Items Found", Buttons:=vbInformation
End If
'***************************************************
Application.ScreenUpdating = True


End Sub

Answer 1

查看你的代码...几点：

为什么不将A，B，C作为字符串来保存您正在查看的列？这将提高性能。不需要拆分，当您循环而不是A.column时，您只需编写A。
您是否正在尝试找到完整匹配（与部分文本中的匹配相对）？如果是这样，请将值设置为变量，例如aValue = Report.Cells(j, A).Value和bValue = Report.Cells(j, B).Value，然后使用if aValue = bValue then
您是将一列与另一列进行比较，如果 SAME 行中存在匹配项，则会在第三列中显示结果？如果是这样，j循环的目的是什么？只需循环遍历i（这将是您的行）并比较A列和B列中的值。

如果值可以在第二列中的任何行上，那么您可以使用j循环，但更快的方法是在VBA中使用Excel内置查找功能，您将在其中搜索B栏上的值：B。在VBA中使用Excel查找显着更快。

什么是z？
只有大于Int类型的边界时，工作表保存才会失败。这就是你想要的吗？

您的缩进需要更正。

          Exit For
      Else
          'Do Nothing
      End If

以上需要缩进2-3次

实施上述改进，让我知道你是如何进行的。祝你好运。

如何在每100,000个循环中创建一个循环清除缓存？

1 个答案: