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

时间:2016-08-16 15:39:14

标签: arrays vba excel-vba criteria excel

我有一张带有两张纸的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

如果单词“award”在列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

1 个答案:

答案 0 :(得分:0)

首先,您应该做的是更改数据结构。假设您使用的是Excel 2007或更高版本,则可以使用名为Tables的强大功能。如果您突出显示所有数据并转到Insert-> Table,请选中“我的表有标题”复选框,然后按确定,您将看到格式正确的表格。对每张工作表上的两个数据集执行此操作。

这不仅仅是相当格式化,而是所谓的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