如何检查两个集合之间是否复制了任何连续的输入"对"



我有一个Excel工作表,其中包含两组需要用户输入的单元格。第一组有8个输入,第二组有5个。

假设数据集一和二有字母的用户输入,比如:

DataSetOne(0) = A
DataSetOne(1) = B
DataSetOne(2) = C
DataSetOne(3) = D
DataSetOne(4) = E
DataSetOne(5) = F
DataSetOne(6) = G
DataSetOne(7) = H
DataSetTwo(0) = A
DataSetTwo(1) = B
DataSetTwo(2) = H
DataSetTwo(3) = D
DataSetTwo(4) = C

我需要检查复制的数据我只关心是否重复任何两个连续值,而不仅仅是单个值

例如,数据集一包含七个顺序的";"对";输入数据的

Pair 1 = A, B
Pair 2 = B, C
Pair 3 = C, D
Pair 4 = D, E
Pair 5 = E, F
Pair 6 = F, G
Pair 7 = G, H

类似地,数据集二有四对额外的数据:

Pair 8 = A, B
Pair 9 = B, H
Pair 10 = H, D
Pair 12 = D, C

我想看看这双鞋中有没有匹配的。顺序并不重要——只要两对具有相同的两个单独输入,我就需要用一种方式做出决定。如果这两个对都不包含匹配的值,那么我的决定就不同了。

因此,在上面的例子中,之间存在匹配

  • 对1和对8
  • 对3和对12

要查找重复项,即两个列表中都存在的值,最简单的实现方法是简单地在两个列表上迭代进行强力搜索。根据您的应用程序,这可能已经足够好了。

例如:

Public Sub SO70184805_find_duplicates()
Dim DataSetOne(0 To 7) As String
Dim DataSetTwo(0 To 4) As String

Const Delimiter As String = ", "

DataSetOne(0) = "A"
DataSetOne(1) = "B"
DataSetOne(2) = "C"
DataSetOne(3) = "D"
DataSetOne(4) = "E"
DataSetOne(5) = "F"
DataSetOne(6) = "G"
DataSetOne(7) = "H"

DataSetTwo(0) = "A"
DataSetTwo(1) = "B"
DataSetTwo(2) = "H"
DataSetTwo(3) = "D"
DataSetTwo(4) = "C"

Dim PairsOne(0 To 6) As String
Dim PairsTwo(0 To 3) As String

Dim I As Integer
Dim S1 As Variant
Dim S2 As Variant

'Make the lists of pairs
Debug.Print "Pairs from the first list:"
For I = 0 To 6
If (DataSetOne(I) < DataSetOne(I + 1)) Then
PairsOne(I) = DataSetOne(I) & Delimiter & DataSetOne(I + 1)
Else
PairsOne(I) = DataSetOne(I + 1) & Delimiter & DataSetOne(I)
End If
Debug.Print (PairsOne(I))
Next I

Debug.Print
Debug.Print "Pairs from the second list:"
For I = 0 To 3
If (DataSetTwo(I) < DataSetTwo(I + 1)) Then
PairsTwo(I) = DataSetTwo(I) & Delimiter & DataSetTwo(I + 1)
Else
PairsTwo(I) = DataSetTwo(I + 1) & Delimiter & DataSetTwo(I)
End If
Debug.Print (PairsTwo(I))
Next I

Debug.Print
Debug.Print ("Duplicates:"):

Dim NumberOfDuplicates As Integer
NumberOfDuplicates = 0
For Each S1 In PairsOne
For Each S2 In PairsTwo
If (S1 = S2) Then
Debug.Print (S1)
NumberOfDuplicates = NumberOfDuplicates + 1
End If
Next
Next
End Sub

这是输出:

Pairs from the first list:
A, B
B, C
C, D
D, E
E, F
F, G
G, H
Pairs from the second list:
A, B
B, H
D, H
C, D
Duplicates:
A, B
C, D

有些事情,我现在要回家了,所以不能做更多了。如果可能的话,我稍后再去。您需要添加脚本运行时引用才能使用字典。

Sub datasets()
Dim datasetone(7) As String
Dim datasettwo(4) As String
Dim dicPairsOne As New Scripting.Dictionary
Dim dicPairsTwo As New Scripting.Dictionary
Dim l As Long
Dim strPair As String
datasetone(0) = "A"
datasetone(1) = "B"
datasetone(2) = "C"
datasetone(3) = "D"
datasetone(4) = "E"
datasetone(5) = "F"
datasetone(6) = "G"
datasetone(7) = "H"
datasettwo(0) = "A"
datasettwo(1) = "B"
datasettwo(2) = "H"
datasettwo(3) = "D"
datasettwo(4) = "C"
For l = 0 To UBound(datasetone) - 1
strPair = datasetone(l) & "," & datasetone(l + 1)

If Not dicPairsOne.Exists(strPair) Then
dicPairsOne.Add strPair, 1
Else
dicPairsOne(strPair) = dicPairsOne(strPair) + 1
End If

If Not dicPairsOne.Exists(StrReverse(strPair)) Then
dicPairsOne.Add StrReverse(strPair), 1
Else
dicPairsOne(StrReverse(strPair)) = dicPairsOne(StrReverse(strPair)) + 1
End If
Next l
For l = 0 To UBound(datasettwo) - 1
strPair = datasettwo(l) & "," & datasettwo(l + 1)

If Not dicPairsTwo.Exists(strPair) Then
dicPairsTwo.Add strPair, 1
Else
dicPairsTwo(strPair) = dicPairsTwo(strPair) + 1
End If
Next l
For l = 0 To dicPairsOne.Count - 1
If dicPairsTwo.Exists(dicPairsOne.Keys()(l)) Then
Debug.Print dicPairsOne.Keys()(l)
End If
Next l
End Sub

最新更新