宏可以很好地复制数据，直到找到重复数据为止.我要它复制副本

Question

如果此宏在工作表表的a列中找到与工作表Source_1的a列匹配的值，则它会将某些单元格从工作表Source_1复制到工作表表。问题是，如果值在工作表Source_1的A列中重复。它一次又一次地复制工作表Source_1中第一次出现的单元格。我希望它复制不同的出现(行(。

Sub RechercheValeursFSI_1()
Dim FeSource As Worksheet
Dim FeDest As Worksheet
Dim PlgSource As Range
Dim PlgDest As Range
Dim Cel As Range
Dim Ligne As Long
Set FeSource = Worksheets("SOURCE_1")
Set FeDest = Worksheets("Table")
With FeSource
Set PlgSource = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
With FeDest
Set PlgDest = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
For Each Cel In PlgDest
On Error Resume Next
Ligne = Application.WorksheetFunction.Match(Cel.Value, PlgSource, 0) + 1
If Err.Number = 0 Then
Cel.Offset(, 4).Resize(, 5).Value = FeSource.Cells(Ligne, 1).Offset(, 1).Resize(, 5).Value
End If
Next Cel
End Sub

Answer 1

这对我有效：

Sub RechercheValeursFSI_1()
'Declarations.
Dim FeSource As Worksheet
Dim FeDest As Worksheet
Dim PlgSource As Range
Dim PlgDest As Range
Dim Cel As Range
Dim Ligne As Long
Dim IntCompteur As Integer

'Setting variables.
Set FeSource = Worksheets("SOURCE_1")
Set FeDest = Worksheets("Table")
With FeSource
Set PlgSource = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
With FeDest
Set PlgDest = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

'Covering the whole PlgDest.
For Each Cel In PlgDest
On Error Resume Next

'Setting Ligne for each occurence the code already met.
IntCompteur = 0
Ligne = 0
Do Until IntCompteur >= Excel.WorksheetFunction.CountIf(FeDest.Range(FeDest.Cells(1, 1), Cel), Cel.Value)
Ligne = Application.WorksheetFunction.Match(Cel.Value, PlgSource.Resize(PlgSource.Rows.Count - Ligne + 1).Offset(Ligne - 1, 0), 0) + Ligne
IntCompteur = IntCompteur + 1
Loop

'Copy-pasting the values.
If Err.Number = 0 Then
Cel.Offset(, 4).Resize(, 5).Value = FeSource.Cells(Ligne, 1).Offset(, 1).Resize(, 5).Value
End If

Next Cel

End Sub

我添加了一个整数变量(IntCompteur(来运行Do循环。循环根据已经覆盖的单元格中以前出现的Cel值的数量重复自身。它设置Ligne值，直到它到达所需的单元格。它基本上实现了在搜索给定值的匹配函数内调整范围的大小。