Excel VBA：复制列值相同的行答案

【问题标题】：Excel VBA: Copy rows where column value is sameExcel VBA：复制列值相同的行
【发布时间】：2018-11-24 04:23:13
【问题描述】：

目标： 我想将 [Col2] 和 [Numeric Column] 中的值作为新行插入到模板中，以供 [Col1] 中的所有值相同。我还想在一个单元格中使用 [Col1] 中的值。

一些附加信息：第 1 列是发票的标识符/对应物。第 2 列是产品类型，数字列是货币金额。

我有一张桌子：

Col1 Col2 Col3 Numeric Column 0001 Value B Ref1 100 0001 Value B Ref2 101 0001 Value C Ref3 99 0002 Value C Ref4 100 0002 Value B Ref5 101 0003 Value C Ref6 99 0004 Value B Ref7 100 0004 Value C Ref8 101

我想要实现的是：

Sub Example()
Dim n As Integer
Dim Source As Worksheet
Dim Target As Worksheet

Set Source = ActiveWorkbook.Worksheets("source")
Set Target = ActiveWorkbook.Worksheets("target")

For each n = 2 in Range([Col1]) 
  //Where the Values in Col1 are the same

  //Copy Value in Col 1 to Target Sheet in cell A1 {used only once}
  //Copy each value in Col1 - Col3 into row 2 and below for each value where Col 1 is same

如何设置一个变量，该变量将继续执行某些操作，直到 [Col 1] 中的相同值用尽，然后更改为 [col 1] 中的下一组值，而无需引用 [col 的唯一值1] 在单独的表格/工作表中？

【问题讨论】：

除非你绝对需要 VBA，否则你可以use a VLOOKUP to return multiple results
@cybernetic.nomad 我需要将值复制到模板/填充发票。发票总数在数百张，所以我需要使用 VBA。谢谢:)

标签： excel vba

【解决方案1】：

您需要的是dictionary。你需要这样的东西：

 Dim dict As Scripting.Dictionary
 Set dict = New Scripting.Dictionary
 Dim i As Long
 With dict
     For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
         If Not dict.Exists(.Cells(i, 1).Value2) Then dict.Add .Cells(i, 1).Value2, i
     Next
 End With

【讨论】：