如果宏Source_1
在工作表Table的A列中找到与工作表的A列匹配的值,则该宏将工作表之间的某些单元格复制到工作表Source_1
。问题是,如果在工作表的A列中值重复Source_1
。它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
这对我有用:
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)来运行循环循环。循环根据已经覆盖的单元格中先前出现的Cel值的次数重复进行。它设置Ligne值,直到到达所需的单元格为止。它基本上实现了在搜索给定值的匹配函数中调整范围的大小。
本文收集自互联网,转载请注明来源。
如有侵权,请联系[email protected] 删除。
我来说两句