如果满足条件，则需要复制行的 Excel VBA 代码

Question

我有一个带有两张纸的 excel 文档。表 1 具有 A-Q 列，表 2 具有 A-H 列。我需要的是一个代码，如果满足条件，它将连续将信息从表 1 复制到表 2。标准是 L 列（表 1）中的“已授予”一词。 也可以只复制行中的特定列吗？

A    B    C    D    E    F    G    H    I   J   K   L      M   N
          X    X                                  Awarded  X   X

如果“已授予”一词在 L 列中，我只想从行中复制 C、D、M 和 N 列。此信息将按以下方式复制到工作表 2

Sheet 1       Sheet 2  
D        -->   B  
C        -->   C  
M        -->   D  
N        -->   F

我希望我是清楚的。提前感谢，如果我需要澄清，请告诉我！+

这是我目前拥有的代码，它可以工作。唯一的问题是，当我只想复制 D、C、M 和 N 行时，它会将整行信息复制到工作表 2 中。

Sub testing()
Set a = Sheets("Sheet1")
Set b = Sheets("Sheet2")
Dim d
Dim j
d = 1
j = 2

Do Until IsEmpty(a.Range("L" & j))



 If a.Range("L" & j) = "Awarded" Then
 d = d + 1
 b.Rows(d).Value = a.Rows(j).Value

 End If
 j = j + 1

Loop
End Sub

Answer 1

首先你应该做的是改变你的数据结构。假设您使用的是 Excel 2007 或更高版本，则有一个很棒的功能称为表格。如果您突出显示所有数据并转到插入->表格，选择“我的表格有标题”复选框，然后按确定，您将看到一个格式良好的表格。对每张纸上的两个数据集都这样做。

这不仅仅是漂亮的格式，它就是所谓的 ListObject。在您的 VBA 代码中，使用以下代码来引用它：

Dim Table1 as ListObject, Table 2 as ListObject
Dim HeaderIndex as Integer
Dim MyColumnRange as Range

Set Table1 = Sheet1.ListObjects("TableName1") 
    `Change the table name under Formulas->Name Manager
Set Table2 = Sheet1.ListObjects("TableName2") 

HeaderIndex = Application.WorksheetFunction.Match("ColumnLHeaderName", _ 
    Table1.HeaderRowRange, 0)
Set MyColumnRange = Table1.ListColumns(HeaderIndex).DataBodyRange
MyColumnRange.Select

此时，select 语句只是为了向您显示您现在正在处理的范围。 HeaderIndex 是指表 ListObject 的表头子组件。使用 Match() 将允许您指定列标题的名称，而无需对其位置进行硬编码。 （即如果您的数据从 A 列开始，则 L 列中的标题值将返回 HeaderIndex = 12）

现在您已经知道想要什么列，您可以选择 ListColumn 对象。然后，DataBodyRange 用于选择该对象的范围组件。这是该列中的整个范围。然后，您可以遍历列表以找到所需的数据。

编辑：更新示例：

'Specify your ranges you will be copying from beforehand, adding as many as you need here.
HeaderIndex_D = Application.WorksheetFunction.Match("ColumnXHeaderName", _ 
    Table1.HeaderRowRange, 0)
HeaderIndex_C = Application.WorksheetFunction.Match("ColumnXHeaderName", _ 
    Table1.HeaderRowRange, 0)
HeaderIndex_M = Application.WorksheetFunction.Match("ColumnXHeaderName", _ 
    Table1.HeaderRowRange, 0)
HeaderIndex_N = Application.WorksheetFunction.Match("ColumnXHeaderName", _ 
    Table1.HeaderRowRange, 0)
Set ColumnRange_D= Table1.ListColumns(HeaderIndex_D).DataBodyRange
Set ColumnRange_C= Table1.ListColumns(HeaderIndex_C).DataBodyRange
Set ColumnRange_M= Table1.ListColumns(HeaderIndex_M).DataBodyRange
Set ColumnRange_N= Table1.ListColumns(HeaderIndex_N).DataBodyRange


'Now, loop through each row that exists in your table. If the testing 
'condition contained in MyColumnRange you previously defined is met,
'then assign the destination cell (which can be defined in the same way
'as above) equal to the lookup range's current row value (specified by i)
For i = 1 to MyColumnRange.Rows.Count
    If MyColumnRange(i) = "Awarded" Then
        DestinationCell1.Value = ColumnRange_D(i)
        DestinationCell2.Value = ColumnRange_C(i)
        DestinationCell3.Value = ColumnRange_M(i)
        DestinationCell4.Value = ColumnRange_N(i)
    End If
Next i