excel VBA循环然后根据条件进行复制

时间:2014-12-16 16:32:42

标签: excel-vba vba excel

对于宏和VBA而言,我绝对是一个新手,需要一些帮助。

我有一个包含6个工作表的工作簿。第一份工作表("所有拨款FY15和#34;)有5列("日期","格兰特","类型"," ;金额"和"类别",A2:E2)。我正在使用此工作表输入所有拨款费用。其余的工作表(" City ESG"," County ESG"," CoC HMIS"," SSVF HMIS"和" HMIS计划费用")在同一位置具有相同的列。在每个后续工作表中,我都有一个授权的名称(与将放置在"所有拨款FY15",B2:B500上的值相匹配)放在F2。

我正在寻找一种方法来遍历"所有拨款FY15",读取B2:B500的值,并将该行复制到相应工作表上的下一个空白行,该工作表上的F2等于B2"所有拨款2015财年和#34;。

这有意义吗? 甲

2 个答案:

答案 0 :(得分:0)

第1步:

在"所有拨款中,2015财年和#34;表格,在"类别"之后添加一列使用=A2复制日期列的列。要将此公式扩展到最后使用的行,请双击包含第一个公式的单元格右下角的小方块。

第2步:

在每个剩余的工作表中,在"日期"列,在标题下的第一个单元格中添加以下公式:

=VLOOKUP($B2,Sheet1!$B$2:$F$500,5) - 更改" Sheet1"必要时

在" Grant"之后的三列中列 - "键入","金额"和"类别" - 添加以下公式:

=VLOOKUP($B2,Sheet1!$B$2:$F$500,2) - 更改" Sheet1"必要时

=VLOOKUP($B2,Sheet1!$B$2:$F$500,3) - 更改" Sheet1"必要时

=VLOOKUP($B2,Sheet1!$B$2:$F$500,4) - 更改" Sheet1"必要时

注意:如果你的某些"日期"在"所有拨款2015财年"表格,将公式更改为=IF(ISBLANK(A2),"",A2)

如果你的任何数据都在"所有拨款2015财年和#34;工作表可能为空白,将剩余的公式更改为:

=IF(ISNA(VLOOKUP($B2,Sheet1!$B$2:$F$500,5)),"",VLOOKUP($B2,Sheet1!$B$2:$F$500,5))

=IF(ISNA(VLOOKUP($B2,Sheet1!$B$2:$F$500,5)),"",VLOOKUP($B2,Sheet1!$B$2:$F$500,2))

=IF(ISNA(VLOOKUP($B2,Sheet1!$B$2:$F$500,5)),"",VLOOKUP($B2,Sheet1!$B$2:$F$500,3))

=IF(ISNA(VLOOKUP($B2,Sheet1!$B$2:$F$500,5)),"",VLOOKUP($B2,Sheet1!$B$2:$F$500,4))

示例

以下是一个示例,让您更好地了解这些公式的位置:

"所有拨款2015财年和#34;片:

       A        B        C         D           E           F
1  Date       Grant     Type     Amount     Category    (blank)
2  1/12/2014  abcd      efgh     1234       ijkl        1/12/2014
3             BCDE      FGHI     2345       JKLM
                                                           ^
                                                           |
                                                           |
                                                  =IF(ISBLANK(A2),"",A2)

"城市ESG"片:

       A        B        C         D           E
1  Date       Grant     Type     Amount     Category
2  1/12/2014  abcd      efgh     1234       ijkl
3             BCDE      FGHI     2345       JKLM
       ^                  ^        ^          ^
       |                  |        |          |
       |                  |        |          |
       |                  |        |    =IF(ISNA(VLOOKUP($B2,'All Grants FY15'!$B$2:$F$13,4)),"",VLOOKUP($B2,'All Grants FY15'!$B$2:$F$13,4))
       |                  |        |
       |                  |    =IF(ISNA(VLOOKUP($B2,'All Grants FY15'!$B$2:$F$13,3)),"",VLOOKUP($B2,'All Grants FY15'!$B$2:$F$13,3))
       |                  |
       |              =IF(ISNA(VLOOKUP($B2,'All Grants FY15'!$B$2:$F$13,2)),"",VLOOKUP($B2,'All Grants FY15'!$B$2:$F$13,2))
       |
   =IF(ISNA(VLOOKUP($B2,'All Grants FY15'!$B$2:$F$13,5)),"",VLOOKUP($B2,'All Grants FY15'!$B$2:$F$13,5))

显然,对于B3电话," $ B2"将改为" $ B3"等等。

答案 1 :(得分:0)

我添加了一个IF语句来检查列#34; F"在源表上为0或1测试是否已移动。当它被移动时,在#34; F"列中标记1; (即col#6)。由于你只需要移动5列,我摆脱了lastCol变量并且从lCol 1到5而不是lastCol。如果某些内容没有被复制,那么列中就不会有1" F"并且可能是因为没有一张纸具有值=列#34; B" -grant。

Sub GrantCopy()

Dim lastRow As Long
Dim lastTRow As Long    'Last Target Row
Dim tRow As Long        'Target Row
Dim source As String    'The source sheet
Dim target As String    'Variable target sheet
Dim tempVal As String   'Hold value of Source!B2
Dim ws As Worksheet

source = "ALL Grants FY15"
lastRow = Sheets(source).Range("A" & Rows.Count).End(xlUp).Row

    For lRow = 3 To lastRow                 'Loop through source sheet
        If Sheets(source).Cells(lRow, "F").Value < 1 Then 'Check to make sure not already moved
            tempVal = Sheets(source).Cells(lRow, "B").Text

            For Each ws In Worksheets             'Loop through all sheets
                If ws.Name <> source Then       'Make sure not checking Source sheet
                    target = ws.Name

                    If Sheets(target).Range("F2").Text = tempVal Then      'Does "B(row)" = F2
                        lastTRow = Sheets(target).Range("A" & Rows.Count).End(xlUp).Row  'Get Last Row
                        tRow = lastTRow + 1             'Set new Row 1 after last

                        For lCol = 1 To 5        'Copy cells from one sheet to another loop columns
                            Sheets(target).Cells(tRow, lCol) = Sheets(source).Cells(lRow, lCol).Value
                        Next lCol
                        Sheets(source).Cells(lRow, "F") = 1   'Mark row as having been moved with a "1"
                    End If
                End If
            Next ws
        End If
    Next lRow
End Sub