更好的匹配,比较和replace差异方法

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

它的工作,不要误会我的意思。 我为自己感到骄傲。 但是比较这些数据有点过重了。

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 

这可能是在电子表格中添加大量评论总是会很慢。 如果是这样的话,你可能会考虑用不同的方式处理,就像阴影表一样。 如果你的所有单元格都会以评论结束,那么你也可以使评论数据更易于理解。

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

第二个(或唯一的) WorksheetFunction.Match调用每次重新build立一个search范围; 该范围可以设置一次并使用。 这将避免在循环中需要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) : 

这将是值得testing如何执行时间分裂之间的匹配和更新。 如果Match比较慢,那么拉下键(对于Master和Update)并对它们进行sorting,然后简单地遍历,可能会更好。 为了节省编码,您可以让Excel在临时表单中进行关键分类工作。

我假设Set_Variables调用closuresScreenUpdating。

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

编辑2 :testing,并获得更多的时间,将UBound(updateShtArr, 1)UBound(updateShtArr, 2)到variables

最大限度地使用数组(不可能有注释)

代码应该是如下(testing):

 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