поиск повторяющихся значений на двух листах

Question

У меня есть данные Excel на двух листах, подобные этим ...

sheet1:  2000, 3000, 4500, 300, 2000, 3000      
sheet 2: 300, 2000, 3000, 4550

Я запускаю следующий код, чтобы выделить значения на обоих листах разными цветами, где значение соответствует критериям.но проблема заключается в значениях sheet1 все 2000, 3000, заполненных цветами, тогда как sheet2, имеющих 2000, 3000 только один раз.если сравнить с листом 2, он содержит значения 2000, 3000 только один раз, поэтому значения листа1, первого и второго, заполняются цветами, остальные значения (последние два значения) не должны быть цветными.

большое спасибо за решение.

Sub Dupranges()

Dim wr1 As Range, wr2 As Range, Rng1 As Range, Rng2 As Range


Set wr1 = Worksheets("Sheet1").Range("f1:f10")
Set wr2 = Worksheets("Sheet2").Range("g1:g10")


For Each Rng1 In wr1
    Rng1.Value = Rng1.Value
    For Each Rng2 In wr2
        If Rng1.Value = Rng2.Value Then 
            Rng1.Interior.ColorIndex = 43
            Rng2.Interior.ColorIndex = 33
            Exit For
        End If
    Next
Next

MsgBox "Successfully completed"

End Sub

Answer 1

Ваш код почти в порядке, но вы можете сэкономить время, перемещая диапазоны в массивы.

Option Explicit

Sub showDupes(src As Range, tgt As Range)
    Dim c As Range, i As Long, srcVal
    Dim a As Variant, found As Boolean

    a = tgt.Value2   'store tgt into array for speed

    For Each c In src
        srcVal = c.Value2
        found = False
        For i = 1 To UBound(a)
            If a(i, 1) = srcVal Then
                found = True
                Exit For
            End If
        Next i
        If found Then
            'highlight in src
            c.Interior.ColorIndex = 43
            'highlight in tgt
            tgt.Cells(i, 1).Interior.ColorIndex = 43
        End If
    Next c
End Sub

Sub showDupes_test()
    showDupes Sheet1.Range("B4").CurrentRegion, Sheet2.Range("b4").CurrentRegion
End Sub

Обратите внимание, что в этой версии, если tgt имеет локальные дубликаты, будет выделен только первый.

Answer 2

Я думаю, я получил то, что вы хотели, это не красиво, но я только начал VBA.Вы должны изменить диапазон обратно на ваш

Sub format()

Dim wr1 As Range, wr2 As Range


Set wr1 = Worksheets("Sheet1").Range("a1:a10")
Set wr2 = Worksheets("Sheet2").Range("a1:a10")


For i = 1 To wr1.Count
check_value = wr1.Item(i)
For k = 1 To wr2.Count
    check_value2 = wr2.Item(k)
    If (check_value = check_value2) And (wr2.Item(k).Interior.ColorIndex = 33) And 
(wr1.Item(i).Interior.ColorIndex = 43) Then
    Else
    If (check_value = check_value2) And (wr2.Item(k).Interior.ColorIndex <> 33) And 
(wr1.Item(i).Interior.ColorIndex <> 43) And (wr2.Item(k).Value > "") Then
    wr1.Item(i).Interior.ColorIndex = 43
    wr2.Item(k).Interior.ColorIndex = 33
        Exit For
    End If
   End If
Next
Next


MsgBox "Successfully completed"

End Sub

Надеюсь, вы найдете это с пользой