excel - 数据冲突-重复值

我创建了一个宏，用另一个工作表中的特定数据填充丢失的数据，这些代码非常适用于从客户端的excel复制粘贴数据并准备开始工作所需的数据，但这是下面的唯一问题

码：

   With Worksheets("Feuil2")
   ' reference "target" sheet (change "Target" to our actual target sheet name)
     With .Range("B1:B" & .Cells(.Rows.Count, 1).End(xlUp).Row) 'reference
         its column B range from row 1 down to last not empty one
        If WorksheetFunction.CountBlank(.Cells) > 0 Then
 ' if any blank cell in referenced range. this check to avoid error thrown by subsequent
    statament
            .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=index(GDC!" & rng.Offset(, 1).Address(, , xlR1C1) & ",match(RC[-1],GDC!" & rng.Address(, , xlR1C1) & ",0))" 'fill blank cells with a lookup (well, sort of) formula
            .Value = .Value 'get rid of formulas and leave values only
            Cells.Select
        End If
    End With
End With

该代码可以完美地匹配和填充数据，但是例如当找到重复的值时，它仅复制第一个值，而不复制第二个值

请参见下图，以更好地了解主要问题：



正如您在图像中看到的那样，问题是A列中的数据可能像此值P20845一样重复了两次，在F列中重复了一个，名称为Ghaith，另一个为sirine，但是您可以在中看到A列只是名字叫盖思（Ghaith），没有锡林（sirine）的名字
解决这个问题并获得所有需要的数据的任何想法或更好的解决方案？ 。

最好的祝福

POLOS

最佳答案

或使用字典

Option Explicit

Public Sub AddValues()
    Application.ScreenUpdating = False
    Dim wb As Workbook, wsSource As Worksheet, wsTarget As Worksheet, masterDict As Object, arr() As Variant, i As Long, rng As Range
    Set wb = ThisWorkbook
    Set wsSource = wb.Worksheets("Feuil1")
    Set wsTarget = wb.Worksheets("Feuil2")
    Set masterDict = CreateObject("Scripting.Dictionary")

    With wsSource
        arr = Intersect(.Columns("A:B"), .UsedRange)
        For i = 1 To UBound(arr, 1)
            If Not masterDict.exists(arr(i, 1)) Then masterDict.Add arr(i, 1), GetAllMatches(arr(i, 1), arr(i, 2), wsSource)
        Next i
    End With

    With wsTarget
        For Each rng In Intersect(.Columns("A"), .UsedRange)
            On Error Resume Next
            rng.Offset(, 1) = masterDict(rng.Value)
            On Error GoTo 0
        Next rng
    End With
    Application.ScreenUpdating = True
End Sub
Public Function GetAllMatches(ByVal findString As String, ByVal dupString As String, ByVal searchRng As Worksheet) As String

    Dim foundCell As Range
    Dim concatenatedString As String
    concatenatedString = vbNullString

    With Intersect(searchRng.Columns(1), searchRng.UsedRange)

        Set foundCell = .Find(findString)
        If foundCell Is Nothing Then Exit Function
        If Not foundCell Is Nothing Then concatenatedString = foundCell.Offset(, 1)

        Dim currMatch As Long
        currMatch = 0

        For currMatch = 1 To WorksheetFunction.CountIf(.Cells, findString)

            Set foundCell = .Find(What:=findString, After:=foundCell, _
                                  LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                                  SearchDirection:=xlNext, MatchCase:=False)

            If Not foundCell Is Nothing And InStr(1, dupString, concatenatedString) = 0 Then
                concatenatedString = concatenatedString & "/" & foundCell.Offset(, 1)
            Else
                concatenatedString = foundCell.Offset(, 1)
            End If
        Next currMatch
    End With
    GetAllMatches = concatenatedString
End Function

Feuil2中的输出

关于excel - 数据冲突-重复值，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/49778413/