VBA比较2个数组,使用逗号分隔符将单值写入单元格

我有一系列的2个单元格,其中值由逗号分隔符分隔。

单元格D1 = 1,2,3,4,5,6,7,8,9,10

单元格O1 = 1,2,3,4,5,6

我想先使用split函数将值传递给一个数组,然后比较这两个数组来找出唯一的/不是double值。 这些值,然后我想写入另一个单元格作为逗号分隔符的值。 根据这个答案

比较二维数组和我发现有关向数组中添加值的东西,我试着用这段代码运气

Sub compare() Dim cont As Long Dim x As Long Dim y As Long Dim Source As Variant Dim Comparison As Variant Dim Target As Variant With ThisWorkbook.Worksheets("Open items") For cont = 1 To .Cells(Rows.Count, 4).End(xlUp).Row Source = Split(.Range("D" & cont).Value, ",") Comparison = Split(.Range("O" & cont).Value, ",") For x = LBound(Source) To UBound(Source) For y = LBound(Comparison) To UBound(Comparison) If Source(x, y) = !Comparison(x, y) Then Target(UBound(Target)) = Source(x, y).Value Next Next Next cont End Sub 

但似乎卡住了。 这是向数组目标添加值的正确方法吗? 如何将数组放入单元格?

我的例子中的结果应该是Target包含“7”,“8”,“9”和“10”,并且应该显示在单元格中

7,8,9,10

感谢您的帮助!

一些问题:

  • Rows.Count将在活动工作表中查找,不一定在“打开项目”工作表中。 所以你需要添加点: .Rows.Count
  • Source(x, y)将不起作用,因为Source只有一个维度。 事实上,与Source无关。 Comparison有类似的说法。
  • = ! 不是有效的比较运算符。 你可能打算<>
  • Target未定义, Target(UBound(Target))将始终引用相同的位置。 相反,你可以将结果附加到一个stringvariables立即。

此外,我会使用一个Collection对象来快速查找,所以algorithm不是O(n²) ,而是O(n)

 Sub Compare() Dim cont As Long Dim source As Variant Dim comparison As Variant Dim part As Variant Dim parts As Collection Dim result As String With ThisWorkbook.Worksheets("Open items") For cont = 1 To .Cells(.Rows.Count, 4).End(xlUp).Row source = Split(.Range("D" & cont).Value, ",") comparison = Split(.Range("O" & cont).Value, ",") ' Add the source items in a collection for faster look-up Set parts = New Collection For Each part In source parts.Add Trim(part), Trim(part) Next ' Remove the comparison items from the collection For Each part In comparison On Error Resume Next ' Ignore error when part is not in parts parts.Remove Trim(part) If Err Then parts.Add Trim(part), Trim(part) ' Add part if not yet in parts On Error GoTo 0 ' Stop ignoring errors Next ' Turn the remaining collection to comma-separated string result = "" For Each part In parts result = result & ", " & part Next result = Mid(result, 3) ' Remove first comma and space ' Store the result somewhere, for example in the E column .Range("E" & cont).Value = result Next cont End With End Sub 

sorting列表的替代方法

当你的源代码和比较列表按照数字顺序sorting,并且你需要目标来维护sorting顺序时,你可以使用一个串联types的迭代,如下所示:

 Sub Compare() Dim cont As Long Dim source As Variant Dim comparison As Variant Dim x As Long Dim y As Long Dim result As String With ThisWorkbook.Worksheets("Open items") For cont = 1 To .Cells(.Rows.Count, 4).End(xlUp).Row source = Split(.Range("D" & cont).Value, ",") comparison = Split(.Range("O" & cont).Value, ",") x = LBound(source) y = LBound(comparison) result = "" Do While x <= UBound(source) And y <= UBound(comparison) If Val(source(x)) < Val(comparison(y)) Then result = result & ", " & Trim(source(x)) x = x + 1 ElseIf Val(source(x)) > Val(comparison(y)) Then result = result & ", " & Trim(comparison(y)) y = y + 1 Else x = x + 1 y = y + 1 End If Loop ' Flush the remainder of either source or comparison Do While x <= UBound(source) result = result & ", " & Trim(source(x)) x = x + 1 Loop Do While y <= UBound(comparison) result = result & ", " & Trim(comparison(y)) y = y + 1 Loop result = Mid(result, 3) ' Remove first comma and space ' Store the result somewhere, for example in the E column .Range("E" & cont).Value = result Next cont End With End Sub 

试试这个小UDF()

 Public Function unikue(BigString As String, LittleString As String) As String Dim B As Variant, L As Variant, Barr, Larr Dim Good As Boolean Barr = Split(BigString, ",") Larr = Split(LittleString, ",") For Each B In Barr Good = True For Each L In Larr If L = B Then Good = False Next If Good Then unikue = unikue & "," & B Next B If unikue <> "" Then unikue = Mid(unikue, 2) End Function 

在这里输入图像说明

与这个代码的东西的情侣

variablesTarget() – 你永远不会告诉代码这个数组有多大,或者如果你想让它变大 – 下面的完整代码将会增长

Source(x,y).Value – 你不需要为数组使用Value。 你也不需要x和y,因为你只在一列中阅读,你只需要source(x)

在完整的代码里写了MISSING的地方 – 这些代码丢失了,会导致你的问题。

Found的目的是每当在比较(y)中find源(x)时,Found就会增加。 如果它从来没有增加,那么我们可以认为它是被捕获的目标。

另外一个需要注意的是,你不指定你要输出Target的位置。 所以目前的目标arrays不会去任何地方

 Sub compare() Dim cont As Long Dim x As Long Dim y As Long Dim Source As Variant Dim Comparison As Variant Dim Target() As Variant ReDim Target(1) With ThisWorkbook.Worksheets("Open items") For cont = 1 To .Cells(.Rows.Count, 4).End(xlUp).Row Source = Split(.Range("D" & cont).Value, ",") Comparison = Split(.Range("O" & cont).Value, ",") For x = LBound(Source) To UBound(Source) Found = 0 For y = LBound(Comparison) To UBound(Comparison) If Source(x) = Comparison(y) Then Found = Found + 1 'count if found End If 'MISSING Next 'if values are found dont add to target If Found = 0 Then Target(UBound(Target)) = Source(x) ReDim Preserve Target(UBound(Target) + 1) End If Next Next cont End With 'MISSING End Sub