Question

所以我现在已经在这张纸上打了几个星期了。我觉得我已经接近完成了。它完成了我的客户希望它做的所有事情。我的新奋斗是当我用客户真实数据填充它时。初始过滤后约有30,000行和14列。对于我寻找匹配，比较和替换的方法来说，这太过分了。我正在做的事情非常明显。我在第一列中搜索匹配，然后比较相邻的单元格。如果存在差异，我将主单元格数据移动到注释中并将更新数据移动到主单元格中。

它有效，不要误会我的意思。我为自己感到骄傲。但比较数据有点超载我的方式。

Sub Compare_Function_MatchEval()
        Call Set_Variables
        UpdateSheet.Activate
        For w = 5 To UpdateSheet.UsedRange.Rows.Count
            v = 1
            CellVal = UpdateSheet.Cells(w, 1).Value
            MasterSheet.Activate
            z = Application.WorksheetFunction.Match(CellVal, Range(Cells(1, 1), Cells((Rows.Count), 1)), 0)
            For y = 2 To UpdateSheet.UsedRange.Columns.Count
                v = v + 1
                If Not UpdateSheet.Cells(w, v) = MasterSheet.Cells(z, v) Then
                    OldData = MasterSheet.Cells(z, v)
                    NewData = UpdateSheet.Cells(w, v)
                    MasterSheet.Cells(z, v).AddComment
                    MasterSheet.Cells(z, v).Comment.Text Text:=OldData
                    MasterSheet.Cells(z, v).Comment.Visible = False
                    MasterSheet.Cells(z, v) = NewData
                End If
            Next
        Next
        wbMaster.Application.ScreenUpdating = True
        wbMaster.Application.Calculation = xlCalculationAutomatic
End Sub

Answer 1

在电子表格中添加大量注释可能总是很慢。如果是这样，您可能会考虑以不同的方式处理，例如使用阴影表。如果您的所有单元格最终都会以评论结束，那么您最好还是可以更轻松地获取评论数据。

根据您的评论，第一个WorksheetFunction.Match调用是死代码，所以希望您的时序结果不能反映给定的代码。

第二次（或仅）WorksheetFunction.Match次呼叫每次都会重新建立一个搜索范围; Range可以设置一次并使用。这样可以避免在循环中需要MasterSheet.Activate。你可以这样说：

    Dim SearchZone as Range
        :
        MasterSheet.Activate
        Set SearchZone = Range(Cells(1, 1), Cells((Rows.Count), 1))

        For w = 5 To UpdateSheet.UsedRange.Rows.Count
            v = 1
            CellVal = UpdateSheet.Cells(w, 1).Value
            z = Application.WorksheetFunction.Match(CellVal, SearchZone, 0)
            :

值得测试匹配和更新之间的执行时间是如何分开的。如果匹配很慢，那么拔出密钥（对于主和更新）并对它们进行排序，然后简单地遍历，可能会更好。为了节省编码，您可以让Excel在临时表中进行密钥排序工作。

我假设Set_Variables调用正在关闭ScreenUpdating。

Answer 2

<强>编辑;因为变体数组是基于1的

已编辑2 ：经过测试，并获得更多秒数，将UBound(updateShtArr, 1)和UBound(updateShtArr, 2)存储到变量中

最大程度地使用数组（不能使用注释）

代码应该是以下（测试过）：

Option Explicit

Sub Compare_Function_MatchEval()

    Call Set_Variables
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    updateShtArr = UpdateSheet.UsedRange.Value
    masterShtArr = MasterSheet.UsedRange.Value

    iUp1Max = UBound(updateShtArr, 1)
    iUp2Max = UBound(updateShtArr, 2)
    For w = 5 To iUp1Max
        z = GetRow(masterShtArr, iUp1Max, updateShtArr(w, 1))
        If z >= 0 Then
            For v = 2 To iUp2Max
                If Not updateShtArr(w, v) = masterShtArr(z, v) Then
                    With MasterSheet.Cells(z, v)
                      .AddComment
                      .Comment.Text Text:=masterShtArr(z, v)
                      .Comment.Visible = False
                      .Value = updateShtArr(w, v)
                    End With
                End If
             Next v
         End If
    Next w

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Function GetRow(arr As Variant, iMax, val As Variant) As Long
    Dim i As Long

    GetRow = -1
    For i = 1 To iMax
        If arr(i, 1) = val Then
            GetRow = i
            Exit Function
        End If
    Next i
End Function

更好地匹配，比较和替换差异方法

2 个答案: