如果条件满足，如何将数据复制到工作表，如果不满足，将数据附加到最后一行？ VBA答案

【问题标题】：how to get data copied to sheet if condition met and if not, append data to last row? VBA如果条件满足，如何将数据复制到工作表，如果不满足，将数据附加到最后一行？ VBA
【发布时间】：2019-02-19 15:17:57
【问题描述】：

数据表（Data Source）的数据格式如下：

Case ID      Contact     Email           Address
999          Jim         jim@jim.com     (blank)
998          (blank)     (blank)         (blank)

问题表（目标）包含已填写问题 1 的案例 ID 列表。有一个问题列表（从问题 2 开始），格式如下 + 所需输出：

Case ID      Issue 1        Issue 2      Issue 3
999                                      address
998          contact        email        address

目标：由于一些案例 ID 已经存在于问题中，因此目标是让宏扫描数据表，如果案例 ID 找到，

检查问题 2 字段是否为空白。如果是，请获取列标题并粘贴到问题中案例 ID 所在的同一行。
如果案例 ID 未找到，则将案例 ID 附加到问题的最后一行 A 列，并将列标题添加到同一行的问题 2 列。李>

目标是在数据表中突出显示具有多个条件的问题，并将它们粘贴到问题表中。在这种情况下，使用下面的代码，IF 语句在数据表上搜索具有 Interior.ColorIndex = 2 的单元格。

问题：我当前的代码没有正确循环，并将 CASE ID's not found 附加到工作表 1 的最后一行。此外，我不确定我的计数器设置是否正确。任何帮助将不胜感激。

Sub IssuesData()

Dim ws As Worksheet
Dim ws2 As Worksheet
Dim lastrow As Long
Dim lastrow2 As Long
Dim lastrow3 As Long
Dim i As Long
Dim j As Long
Dim wb As Workbook

lastrow = ThisWorkbook.Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
lastrow3 = ThisWorkbook.Sheets("Issues").Cells(Rows.Count, "A").End(xlUp).Row

For j = 2 To lastrow3
    For i = 2 To lastrow
        If ThisWorkbook.Sheets("Data").Cells(i, 10).Interior.ColorIndex = 2 Then
            If Sheets("Data").Cells(i, 3) = Sheets("Issues").Cells(j, 1) Then

            Sheets("Issues").Cells(j, "D") = Sheets("Data").Cells(1, 10)

            End If
        j = j + 1


            Else
                If ThisWorkbook.Sheets("Data").Cells(i, 10).Interior.ColorIndex = 2 Then
                lastrow2 = ThisWorkbook.Sheets("Issues").Cells(Rows.Count, "A").End(xlUp).Row
                Sheets("Data").Cells(i, 3).Copy
                Sheets("Issues").Range("A" & lastrow2 + 1).PasteSpecial xlPasteValues
                Sheets("Data").Cells(1, 10).Copy
                Sheets("Issues").Range("D" & lastrow2 + 1).PasteSpecial xlPasteValues
                End If
            End If

    Next i
Next j

End Sub

【问题讨论】：

标签： excel vba loops find range

【解决方案1】：

得到它的工作 - 希望它可以帮助别人！

Sub ReadC1LegalContact()

Dim frng As Variant
Dim i As Long
Dim lastrow As Long
Dim pasteRow As Long



    With ThisWorkbook

        lastrow = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row

        For i = 2 To lastrow

            If Sheets("Data").Cells(i, 60).Interior.ColorIndex = 1 Then
                Set frng = Sheets("Issues").Range("A:A").Find(Sheets("Data").Cells(i, 3), , xlValues, xlWhole)

                If Not frng Is Nothing Then
                    If .Sheets("Issues").Cells(frng.Row, "B") = "" Then
                       .Sheets("Issues").Cells(frng.Row, "B") = .Sheets("Data").Cells(1, 60)
                    End If
                Else
                    pasteRow = .Sheets("Issues").Range("A" & Rows.Count).End(xlUp).Row + 1
                    .Sheets("Issues").Range("A" & pasteRow) = .Sheets("Data").Cells(i, 3)
                    .Sheets("Issues").Range("B" & pasteRow) = .Sheets("Data").Cells(1, 60)
                End If
            End If

        Next i

    End With
End Sub

【讨论】：