2列快速比较法

本文介绍了2列快速比较法的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！ 问题描述 29岁程序员，3月因学历无情被辞！ 对于i = 1 To tmpRngSrcMax 如果rngSrc（i）<> rngDes（i）然后... 下一步我 速度大约快100倍。 我必须使用VBA比较包含字符串数据的两列。这是我的方法： 设置rngDes = wsDes.Range（A2：A& wsDes.Cells（Rows.Count ，1）.End（xlUp）.Row）设置rngSrc = wsSrc.Range（I3：I& wsSrc.Cells（Rows.Count，1）.End（xlUp）.Row） tmpRngSrcMax = wsSrc.Cells（Rows.Count，1）.End（xlUp）.Row cntNewItems = 0 对于每个x在rngSrc tmpFound = Application.WorksheetFunction.CountIf（rngDes，x.Row） Application.StatusBar =Processed：& x.Row& of& tmpRngSrcMax& /&格式（x.Row / tmpRngSrcMax，Percent） DoEvents'保持Excel远离不响应状态 如果tmpFound = 0然后'新项 cntNewItems = cntNewItems + 1 tmpLastRow = wsDes.Cells（Rows.Count，1）.End（xlUp）.Row + 1'目标表上的第一个空行 wsDes.Cells（tmpLastRow，1 ）= wsSrc.Cells（x.Row，9）结束如果下一个x 所以，我使用For Each循环通过第一（src）列和CountIf方法来迭代，以检查项目是否已经存在于第二（des）列中。如果没有，请复制到第1（src）列的末尾。 代码可以工作，但在我的机器上，它需要大约200行给定列，大约有7000行。我注意到CountIf直接作为公式使用的速度更快。 有谁有代码优化的想法？解决方案好的。我们来澄清一些事情。 所以列 A 具有$ code> 10,000 随机生成的值，列 I 具有$ code> 5000 随机生成的值。看起来像这样 我已经针对10,000个单元格运行了3个不同的代码。 i = 1 to ... for j = 1 to ... 方法，您建议的方法 Sub ForLoop（） Application.ScreenUpdating = False Dim stNow As Date stNow = Now Dim lastA As Long lastA = Range（A& Rows.Count）.End（xlUp）.Row Dim lastB As Long lastB = Range（ I& Rows.Count）.End（xlUp）.Row Dim match As Boolean Dim i As Long，j As Long Dim r1 As范围，r2 As范围对于i = 2 To lastA 设置r1 =范围（A& i） match = False 对于j = 3到lastB 设置r2 =范围（I& j）如果r1 = r2然后 match = True 结束如果下一步j 如果不匹配则范围（I& Range（I& Rows.Count）.End（xlUp）.Row + 1）= r1 End If Next i Debug.Print DateDiff（s ，stNow，Now） Application.ScreenUpdating = True End Sub Sid的appraoch Sub Sample（） Dim wsDes As Worksheet，wsSrc As Worksheet Dim rngDes As Range，rngSrc As Range Dim DesLRow As Long，SrcLRow As Long Dim i As Long，j As Long，n As Long Dim DesArray，SrcArray，TempAr（ ）As String Dim boolFound As Boolean 设置wsDes = ThisWorkbook.Sheets（Sheet1）设置wsSrc = ThisWorkbook.Sheets（Sheet2） DesLRow = wsDes.Cells（Rows.Count，1）.End（xlUp）.Row SrcLRow = wsSrc.Cells（Rows.Count，1）.End（xlUp）.Row 设置rngDes = wsDes.Range（A2：A& DesLRow）设置rngSrc = wsSrc.Range（I3：I& SrcLRow） DesArray = rngDes .Value SrcArray = rngSrc.Value 对于i = LBound（SrcArray）到UBound（SrcArray）对于j = LBound（DesArray）到UBound（DesArray）如果SrcArray（i，1）= DesArray j，1）然后 boolFound = True 退出结束如果下一个j 如果boolFound = False然后 ReDim保存TempAr （n） TempAr（n）= SrcArray（i，1）n = n + 1 Else boolFound = False End If Next wsDes.Cells（DesLRow + 1，1）.Resize（UBound（TempAr）+ 1，1）.Value = _ Application.Transpose（TempAr） End Sub 我（mehow）方法 Sub Main（） Application.ScreenUpdating = False Dim stNow As Date stNow = Now Dim arr As Variant arr = Range（A3：A& Range（A& Rows.Count）.End（xlUp）.Row）.Value Dim varr As Variant varr = Range（I3：I& Range I& Rows.Count）.End（xlUp）.Row）.Value Dim x，y，match As Boolean For each x In arr match = False 对于每个y在varr 如果x = y然后match = True 下一个y 如果不匹配则范围（I& Range（ I& Rows.Count）.End（xlUp）.Row + 1）= x End If Next Debug.Print DateDiff（s，stNow，现在） Application.ScreenUpdating = True End Sub 结果如下 ，您选择了快速比较方法：） 填写随机值 Sub FillRandom（） Cells.ClearCont ¢范围（A1）=列A范围（I2）=列I Dim i As Long For i = 2至10002 范围（A& i）= Int（（10002-2 + 1）* Rnd + 2）如果i Range（I& Range（I& Rows.Count）.End（xlUp）.Row + 1）= _ Int（（10002 - 2 + 1）* Rnd + 2） End If Next i End Sub EDIT: Instead for my solution, use something like For i = 1 To tmpRngSrcMax If rngSrc(i) <> rngDes(i) Then ... Next iIt is about 100 times faster.I have to compare two columns containing string data using VBA. This is my approach:Set rngDes = wsDes.Range("A2:A" & wsDes.Cells(Rows.Count, 1).End(xlUp).Row)Set rngSrc = wsSrc.Range("I3:I" & wsSrc.Cells(Rows.Count, 1).End(xlUp).Row)tmpRngSrcMax = wsSrc.Cells(Rows.Count, 1).End(xlUp).RowcntNewItems = 0For Each x In rngSrctmpFound = Application.WorksheetFunction.CountIf(rngDes, x.Row)Application.StatusBar = "Processed: " & x.Row & " of " & tmpRngSrcMax & " / " & Format(x.Row / tmpRngSrcMax, "Percent")DoEvents ' keeps Excel away from the "Not responding" stateIf tmpFound = 0 Then ' new item cntNewItems = cntNewItems + 1 tmpLastRow = wsDes.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' first empty row on target sheet wsDes.Cells(tmpLastRow, 1) = wsSrc.Cells(x.Row, 9)End IfNext xSo, I'm using a For Each loop to iterate trough the 1st (src) column, and the CountIf method to check if the item is already present in the 2nd (des) column. If not, copy to the end of the 1st (src) column.The code works, but on my machine it takes ~200s given columns with around 7000 rows. I noticed that CountIf works way faster when used directly as a formula.Does anyone has ideas for code optimization? 解决方案 Ok. Let's clarify a few things.So column A has 10,000 randomly generated values , column I has 5000 randomly generated values. It looks like thisI have run 3 different codes against 10,000 cells.the for i = 1 to ... for j = 1 to ... approach, the one you are suggestingSub ForLoop()Application.ScreenUpdating = False Dim stNow As Date stNow = Now Dim lastA As Long lastA = Range("A" & Rows.Count).End(xlUp).Row Dim lastB As Long lastB = Range("I" & Rows.Count).End(xlUp).Row Dim match As Boolean Dim i As Long, j As Long Dim r1 As Range, r2 As Range For i = 2 To lastA Set r1 = Range("A" & i) match = False For j = 3 To lastB Set r2 = Range("I" & j) If r1 = r2 Then match = True End If Next j If Not match Then Range("I" & Range("I" & Rows.Count).End(xlUp).Row + 1) = r1 End If Next i Debug.Print DateDiff("s", stNow, Now)Application.ScreenUpdating = TrueEnd SubSid's appraochSub Sample() Dim wsDes As Worksheet, wsSrc As Worksheet Dim rngDes As Range, rngSrc As Range Dim DesLRow As Long, SrcLRow As Long Dim i As Long, j As Long, n As Long Dim DesArray, SrcArray, TempAr() As String Dim boolFound As Boolean Set wsDes = ThisWorkbook.Sheets("Sheet1") Set wsSrc = ThisWorkbook.Sheets("Sheet2") DesLRow = wsDes.Cells(Rows.Count, 1).End(xlUp).Row SrcLRow = wsSrc.Cells(Rows.Count, 1).End(xlUp).Row Set rngDes = wsDes.Range("A2:A" & DesLRow) Set rngSrc = wsSrc.Range("I3:I" & SrcLRow) DesArray = rngDes.Value SrcArray = rngSrc.Value For i = LBound(SrcArray) To UBound(SrcArray) For j = LBound(DesArray) To UBound(DesArray) If SrcArray(i, 1) = DesArray(j, 1) Then boolFound = True Exit For End If Next j If boolFound = False Then ReDim Preserve TempAr(n) TempAr(n) = SrcArray(i, 1) n = n + 1 Else boolFound = False End If Next i wsDes.Cells(DesLRow + 1, 1).Resize(UBound(TempAr) + 1, 1).Value = _ Application.Transpose(TempAr)End Submy (mehow) approachSub Main()Application.ScreenUpdating = False Dim stNow As Date stNow = Now Dim arr As Variant arr = Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row).Value Dim varr As Variant varr = Range("I3:I" & Range("I" & Rows.Count).End(xlUp).Row).Value Dim x, y, match As Boolean For Each x In arr match = False For Each y In varr If x = y Then match = True Next y If Not match Then Range("I" & Range("I" & Rows.Count).End(xlUp).Row + 1) = x End If Next Debug.Print DateDiff("s", stNow, Now)Application.ScreenUpdating = TrueEnd Subthe results as followsnow, you select the fast compare method :)filling in of the random valuesSub FillRandom() Cells.ClearContents Range("A1") = "Column A" Range("I2") = "Column I" Dim i As Long For i = 2 To 10002 Range("A" & i) = Int((10002 - 2 + 1) * Rnd + 2) If i < 5000 Then Range("I" & Range("I" & Rows.Count).End(xlUp).Row + 1) = _ Int((10002 - 2 + 1) * Rnd + 2) End If Next iEnd Sub 这篇关于2列快速比较法的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！ 上岸，阿里云！