VBA比较两张图纸和两列,并检查是否存在差异



我是vba和stackoverflow的新手,所以请放松我!

我有两个工作表,称为worksheet1=GoldCopy和worksheet2=A-OPS。它们有大约10000多行数据,应该有一些类似的数据。我想比较一下这两张纸。它们都有类似的标题:列A=文件名,列D=加密代码列B=文件路径,列F=金色(或A-OPS,取决于您正在查看的ws(。

我希望能够比较ws1和ws2,检查是否有任何差异,并将它们突出显示为FALSE和F列中的红色。我目前希望检查ws1并遍历每一行,看看文件名和加密代码是否在ws2中,不必与ws1是同一行,但我希望文件名和加密代码在同一行(这有意义吗?(WS2可以在第20行有这些数据,但ws1在第10行,但由于它们有相同的文件名和密码,所以没关系。如果ws2具有相同的文件名和相同的加密代码,则ws1列F为TRUE。如果ws2在任何一行中都没有相同的文件名AND加密,则ws1列F为FALSE。我也想做同样的事情,除了对照ws1检查ws2。

这是我到目前为止的代码,但由于这些嵌套的for循环,它需要花费很长时间。我试着研究一种名为";阵列";但我只是很困惑,想要一些快速高效的东西。for循环需要很长时间。请让我知道,如果我需要更具体或解释更多!非常感谢

Sub Check
For Each s In Sheets
'NEW FILE SEARCH A-NAS OPS'
If s.Name = "A OPS" Then 'check if there is an A OPS file if so then proceed'
ACOL = Worksheets("A OPS").Cells(1, Columns.Count).End(xlToLeft).Column
Worksheets("A OPS").Cells(1, ACOL + 1).Value = "In Gold Copy?"

'GoldCopy Check with A-NAS OPS'
Worksheets("GoldCopy").Activate
GROW = Worksheets("GoldCopy").Cells(Rows.Count, 1).End(xlUp).Row
GCOL = Worksheets("GoldCopy").Cells(1, Columns.Count).End(xlToLeft).Column
AROW = Worksheets("A OPS").Cells(Rows.Count, 1).End(xlUp).Row
ACOL = Worksheets("A OPS").Cells(1, Columns.Count).End(xlToLeft).Column
Worksheets("GoldCopy").Cells(1, GCOL + 1) = "Deployed in A OPS?"
For i = 2 To GROW
GCOL = Worksheets("GoldCopy").Cells(1, Columns.Count).End(xlToLeft).Column
If InStr(Worksheets("GoldCopy").Cells(i, 3), "sidata") > 0 Then        'this is checking to see for a filepath from column B'
bln = False
For x = 2 To AROW
If Worksheets("GoldCopy").Cells(i, 1).Value = Worksheets("A OPS").Cells(x, 1) And Worksheets("GoldCopy").Cells(i, 4).Value = Worksheets("A OPS").Cells(x, 4).Value Then    'if the filename and encryption code in the same row in ws2 match ws1 then do next step' 
bln = True
Worksheets("GoldCopy").Cells(i, GCOL) = bln
Worksheets("GoldCopy").Cells(i, GCOL).Interior.ColorIndex = 10
Exit For
Else
Worksheets("GoldCopy").Cells(i, GCOL) = bln
Worksheets("GoldCopy").Cells(i, GCOL).Interior.ColorIndex = 22
End If
Next x
End If
Next i

'A OPS check with GoldCopy'
Worksheets("A OPS").Activate
GROW = Worksheets("GoldCopy").Cells(Rows.Count, 1).End(xlUp).Row
GCOL = Worksheets("GoldCopy").Cells(1, Columns.Count).End(xlToLeft).Column
AROW = Worksheets("A OPS").Cells(Rows.Count, 1).End(xlUp).Row
ACOL = Worksheets("A OPS").Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To AROW
GCOL = Worksheets("GoldCopy").Cells(1, Columns.Count).End(xlToLeft).Column
If InStr(Worksheets("A OPS").Cells(i, 3), "SIDATAopscommon") > 0 Or InStr(Worksheets("A OPS").Cells(i, 3), "SIDATAopsj01ecl") > 0 Or InStr(Worksheets("A OPS").Cells(i, 3), "SIDATAopsnppecl") > 0 Then
bln = False
For x = 2 To GROW
If Worksheets("GoldCopy").Cells(x, 1).Value = Worksheets("A OPS").Cells(i, 1) And Worksheets("GoldCopy").Cells(x, 4).Value = Worksheets("A OPS").Cells(i, 4).Value Then
bln = True
Worksheets("A OPS").Cells(i, ACOL) = bln
Worksheets("A OPS").Cells(i, ACOL).Interior.ColorIndex = 10

Exit For
Else
Worksheets("A OPS").Cells(i, ACOL) = bln
Worksheets("A OPS").Cells(i, ACOL).Interior.ColorIndex = 22

End If
Next
End If
Next

试着完成下面的代码。我在整个代码中分散了注释,以指示代码的作用以及为什么要这样做。看看你是否能将其适应你的实际工作簿。如果您遇到问题,请回信,我们会尽力解决。

'Below code drives the analysis. Get a dictionary of
'unique keys from each sheet, then compare each sheet
'separately. You can pull your "response" into a separate
'function if you need the flexibility to change
Sub AnalyzeSheets()
Dim oGold As Object
Dim oAops As Object
Dim shtGold As Worksheet
Dim shtOps As Worksheet
Dim rngGold As Range
Dim rngOps As Range
Dim iterator As Range
Dim theKey As String

Set shtGold = Worksheets("GoldCopy")
Set shtOps = Worksheets("A Ops")

'Establish the data range for each sheet
'Mine is simply hardcoded
Set rngGold = shtGold.Range("A2:E8")
Set rngOps = shtOps.Range("A2:E7")

'Get a dictionary for each sheet. Pass in
'the range of the data
Set oGold = GetDictionary(rngGold)
Set oAops = GetDictionary(rngOps)

'Analyze each sheet separately
'Use Intersect to only iterate over the cells in the first column
For Each iterator In Intersect(rngGold, shtGold.Columns(1))
theKey = CreateKey(iterator.Value, iterator.Offset(, 3).Value)

If Not oAops.exists(theKey) Then
Respond iterator, False
Else
Respond iterator, True
End If
Next iterator

For Each iterator In Intersect(rngOps, shtOps.Columns(1))
theKey = CreateKey(iterator.Value, iterator.Offset(, 3).Value)

If Not oGold.exists(theKey) Then
'Call a response function. By putting the response
'into it's own function, you don't have to duplicate logic
'and it's easier to change
Respond iterator, False
Else
Respond iterator, True
End If
Next iterator
End Sub
Sub Respond(rng As Range, isFound As Boolean)
Dim sht As Worksheet

Set sht = rng.Parent

If isFound Then
sht.Range("F" & rng.Row).Value = "TRUE"
sht.Range("F" & rng.Row).Interior.ColorIndex = 10
Else
sht.Range("F" & rng.Row).Value = "FALSE"
sht.Range("F" & rng.Row).Interior.ColorIndex = 22
End If

End Sub
'Use this function to generate a unique key for each row
'Since 2 columns form a unique key, I'm simply taking each
'value and joining with a hypen. By pulling this logic into
'it's own function, you have more flexibility for future changes.
Function CreateKey(s1 As String, s2 As String) As String
Dim delimiter As String

delimiter = "-"

CreateKey = s1 & delimiter & s2
End Function
'Use below to create a dictionary holding unique key values
'You can update the code within to identify which cells
'are used to generate a key
Function GetDictionary(inputRange As Range) As Object
Dim oDict As Object
Dim sht As Worksheet
Dim cel As Range
Dim theKey As String

Set sht = inputRange.Parent

Set oDict = CreateObject("Scripting.Dictionary")

For Each cel In Intersect(inputRange, sht.Columns(1))
'(A) - Filename (D) - Encryption
theKey = CreateKey(sht.Range("A" & cel.Row).Value, _
sht.Range("D" & cel.Row).Value)

'If the key hasn't been added, add it (don't need value)
If Not oDict.exists(theKey) Then
oDict.Add theKey, ""
End If
Next cel

Set GetDictionary = oDict
End Function

最新更新