我在一个电子表格中有两个表。两者具有相同的列-名称、城市、省。我的目标是比较两个值,如果三个值中有三个匹配,则拉“是”,如果不匹配,拉“否”。我将行与这两个表(而不是随机单元格)中的行进行比较。
我还没有找到合适的公式,所以可能需要对其进行编码。
我发现了一个很好的代码,但它只适用于在一个数组中查看相同的值。我希望它能适应我的问题。或者我需要另一个。
Sub Compare()
Dim row As Integer
row = 2
Dim firstColumn As String
firstColumn = "H"
Dim lastColumn As String
lastColumn = "J"
Dim resultsColumn As String
resultsColumn = "M"
Dim isFoundText As String
isFoundText = "YES"
Dim isNotFoundText As String
isNotFoundText = "NO"
Do While Range("B" & row).Value <> ""
Dim startChar As Integer
startChar = Asc(firstColumn)
Dim endChar As Integer
endChar = Asc(lastColumn)
Dim i As Integer
Dim hasMatch As Boolean
hasMatch = False
For i = startChar To endChar
If Range(Chr(i) & row).Value = Range(Chr(i + 1) & row).Value Then
hasMatch = True
End If
If Range(Chr(startChar) & row).Value = Range(Chr(i + 1) & row).Value Then
hasMatch = True
End If
Next i
If (hasMatch) Then
Range(resultsColumn & row).Value = isFoundText
Else
Range(resultsColumn & row).Value = isNotFoundText
End If
row = row + 1
Loop
End Sub
发布于 2019-05-30 05:40:49
对于这种类型的任务,最好将数据移动到变量数组中,然后在这些变量数组上执行循环(速度更快)。此外,模式匹配可以从数据中泛化出来,从而实现更可重用的解决方案和关注点的分离
比较函数
Private Function CompareColumns(Table1 As Range, Table2 As Range, ColPairs() As Variant, Optional IsMatch As Variant = True, Optional NoMatch As Variant = False) As Variant
Dim Table1Data As Variant
Dim Table2Data As Variant
Dim OutputData As Variant
Dim rw1 As Long, rw2 As Long
Dim Col As Long
Dim FoundMatch As Boolean
' Move data to variant arrays
Table1Data = Table1.Value2
Table2Data = Table2.Value2
' Size return array
ReDim OutputData(1 To UBound(Table1Data, 1), 1 To 1)
' Loop the arrays
For rw2 = 1 To UBound(Table2Data, 1)
OutputData(rw2, 1) = NoMatch ' initialise
For rw1 = 1 To UBound(Table1Data, 1)
FoundMatch = True
For Col = LBound(ColPairs, 1) To UBound(ColPairs)
If Table1Data(rw1, ColPairs(Col, 1)) <> Table2Data(rw2, ColPairs(Col, 2)) Then
FoundMatch = False ' column not a match, move to next row
Exit For
End If
Next
If FoundMatch Then ' found a match
OutputData(rw2, 1) = IsMatch
Exit For ' exit Table2 loop when match found
End If
Next
Next
' Return result to caller
CompareColumns = OutputData
End Function
像这样使用它
Sub Compare()
Dim ws As Worksheet
Dim Table1 As Range
Dim Table2 As Range
Dim Output As Range
Dim OutputTable As Variant
Dim ColPairs() As Variant
Set ws = ActiveSheet ' update to suit your needs
' Set up ranges by any means you choose
With ws
Set Table1 = .Range(.Cells(2, 1), .Cells(.Rows.Count, 3).End(xlUp))
Set Table2 = .Range(.Cells(2, 10), .Cells(.Rows.Count, 8).End(xlUp))
Set Output = .Cells(2, 13).Resize(Table2.Rows.Count, 1)
End With
'Specify columns to compare
ReDim ColPairs(1 To 3, 1 To 2)
ColPairs(1, 1) = 1: ColPairs(1, 2) = 3
ColPairs(2, 1) = 2: ColPairs(2, 2) = 2
ColPairs(3, 1) = 3: ColPairs(3, 2) = 1
' Call Match function
OutputTable = CompareColumns(Table1, Table2, ColPairs, "Yes", "No")
' Place Output on sheet
Output = OutputTable
End Sub
发布于 2019-05-30 01:59:01
添加一些缩进,这样我们就可以阅读以下内容:
Sub Compare()
Dim firstColumn As String, lastColumn As String, resultsColumn As String, isFoundText As String, isNotFoundText As String,
Dim row As Integer, startChar As Integer, endChar As Integer, i As Integer
Dim hasMatch As Boolean
row = 2
firstColumn = "H"
lastColumn = "J"
resultsColumn = "M"
isFoundText = "YES"
isNotFoundText = "NO"
Do While Range("B" & row).Value <> ""
startChar = Asc(firstColumn)
endChar = Asc(lastColumn)
hasMatch = False
For i = startChar To endChar
If Range(Chr(i) & row).Value = Range(Chr(i + 1) & row).Value Then
hasMatch = True
End If
If Range(Chr(startChar) & row).Value = Range(Chr(i + 1) & row).Value Then
hasMatch = True
End If
Next i
If (hasMatch) Then
Range(resultsColumn & row).Value = isFoundText
Else
Range(resultsColumn & row).Value = isNotFoundText
End If
row = row + 1
Loop
End Sub
现在,要开始做出改变……看起来你可以用一个更简单的循环来清理你的代码,比如(未测试):
Dim lri as long, lrj as long, i as long, j as long
lri = cells(rows.count,"H").end(xlup).row
lrj = range(columns("B"),columns("D")).Find("*", , , , xlByRows, xlPrevious).Row
For i = 2 to lri
For j = 2 to lrj
If Cells(j,"B").Value = cells(i,"J").Value AND Cells(j,"C").Value = Cells(i,"I").Value AND Cells(j,"D").Value = Cells(i,"H").Value Then
Cells(i,"M").Value = "Yes" 'don't need variables for these anymore
'may want to put an exit to j loop if True
Else
Cells(i,"M").Value = "No"
End If
row = row + 1
Loop
这会将每个单元格中的值与其各自的部分(B到J、C到I和D到H)进行比较。
https://stackoverflow.com/questions/56365931
复制相似问题