Можно ли сравнить два столбца в Excel и обновить основной столбец с помощью VBA? - PullRequest
0 голосов
/ 19 марта 2020

У меня есть два листа в моей книге Excel. В этих листах содержатся мои основные столбцы. Я хочу сравнить первый столбец (который является основным) со вторым столбцом (источником), используя VBA l oop. Причина в том, что источник обычно содержит новые первичные ключи. Пожалуйста, кто-нибудь может быть настолько любезен, чтобы помочь мне разобраться в логике c, чтобы сравнить эти столбцы и добавить уникальные значения в основной столбец. Спасибо.

на этом изображении показан пример мастер-кода
на этом изображении показан пример исходного кода

Приведенный ниже код показывает, что я до сих пор

Sub PullUniques()
Dim rngCell As Range
For Each rngCell In Sheet1.Range("W3:W40")
    If WorksheetFunction.CountIf(Range("D3:D40"), rngCell) = 0 Then
        Range("C" & Rows.Count).End(xlUp).Offset(1) = rngCell
    End If
Next
For Each rngCell In Sheet6.Range("D3:D40")
    If WorksheetFunction.CountIf(Range("W3:W40"), rngCell) = 0 Then
        Range("W" & Rows.Count).End(xlUp).Offset(1) = rngCell
    End If
Next

End Sub

1 Ответ

0 голосов
/ 19 марта 2020

Попробуйте этот код, пожалуйста. Он основан на предположении, что в исходном листе могут быть ключи, которых нет на вашем «Мастер» листе, которые будут добавлены в первую пустую строку мастер-листа.

Sub testMasterUpdate()
  Dim shM As Worksheet, shS As Worksheet, s As Long, boolF As Boolean
  Dim lastRM As Long, lastRS As Long, m As Long
  Dim arrM As Variant, arrS As Variant, arrDif As Variant, d As Long

  Set shM = Worksheets("Master") 'please, use here your sheet name
  Set shS = Worksheets("Source") 'please, use here your sheet name
   lastRM = shM.Range("A" & Cells.Rows.Count).End(xlUp).Row
   lastRS = shS.Range("A" & Cells.Rows.Count).End(xlUp).Row
   arrM = shM.Range("A2:A" & lastRM).value
   arrS = shS.Range("A2:A" & lastRS).value
   ReDim arrDif(1 To 1, 1 To UBound(arrM) + UBound(arrS)): d = 1

   For s = 1 To UBound(arrS)
        For m = 1 To UBound(arrM)
            If arrS(s, 1) = arrM(m, 1) Then
                boolF = True
                Exit For
            End If
        Next m
        If Not boolF Then
            arrDif(1, d) = arrS(s, 1)
            d = d + 1
        End If
        boolF = False
   Next s
   If d > 1 Then
     ReDim Preserve arrDif(1 To 1, 1 To d - 1)
     'shM.Range("A" & lastRM + 1).Resize(UBound(arrDif, 2), 1).value = _
                                    WorksheetFunction.Transpose(arrDif)
     shM.Range("A" & lastRM).Resize(UBound(arrDif, 2), 1).value = _
                                WorksheetFunction.Transpose(arrDif)
     lastRM = shM.Range("A" & Cells.Rows.Count).End(xlUp).Row
     shM.Range("A" & lastRM + 1).Formula = "=CountA(A2:A" & lastRM & ")"
   End If
End Sub

Пожалуйста, замените generi c имен листов с вашими настоящими.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...