Question

对于这种情况，我有一个“数据库”电子表格，带有一个供“数据库”使用的子表。目前，我已经编写了一个VBA脚本来检查数据库工作表中工作表每一行中某个单元格的匹配情况。如果找到匹配项，则将子表中的行复制到“数据库”工作表的该行上。

我要添加的另一种条件是，如果在当前定位的子表上未找到匹配项，则将该行添加到“数据库”表的底部。

我尝试添加：

ws2.Rows(ws2Row).EntireRow.Value = ws1.Rows(ws1LastRow + 1).EntireRow.Value

在我的搜索循环之后，但效果不佳，我不确定为什么。

Sub Update_Master()

Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim ws1LastRow As Long, ws2LastRow As Long
Dim ws1Row As Long, ws2Row As Long

Application.ScreenUpdating = False

Set wb1 = ThisWorkbook
Set ws1 = wb1.Worksheets("Sheet1")

Set wb2 = Application.Workbooks.Add("C:\Users\MyFolder\Desktop\Excel Master Test\ROLE BASED TRACKER DRAFT.xlsx")
Set ws2 = wb2.Worksheets("Database")

ws1LastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
ws2LastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row

For ws1Row = 2 To ws1LastRow
    ws1.AutoFilterMode = False
    If ws1.Cells(ws1Row, 4).Value > 0 Then

        For ws2Row = 2 To ws2LastRow
            ws2.AutoFilterMode = False
            If ws2.Cells(ws2Row, 4).Value = ws1.Cells(ws1Row, 4).Value Then
                ws2.Rows(ws2Row).EntireRow.Value = ws1.Rows(ws1Row).EntireRow.Value
            End If

        Next ws2Row

    End If

Next ws1Row

ws2.Rows(ws2Row).EntireRow.Value = ws1.Rows(ws1LastRow + 1).EntireRow.Value

End Sub

Answer 1

因此，我有一个循环，使用Find方法使用SubSheet中的信息更新数据库。如果找不到匹配项，如何从这里复制信息？对不起..我是一个整体编程人员，所以几天前刚接触VBA。

For ws1Row = 2 To ws1LastRow

    Do While ws1.Cells(ws1Row, 4) <> "" 'repeat the following loop until it reaches a blank row

        strSearch = ws1.Cells(ws1Row, 4).Value   'get a hold of the value in column D

        ws1.Rows(ws1Row).EntireRow.Copy 'copy the row to be transferred to the Database

        ws2.Activate

        ws2.Range("D:D").Find(strSearch).Select  'find the row the match is located at on the Database

        r = ActiveCell.Row   'get a hold of current row index

        Range(r & ":" & r).Select

        ActiveCell.PasteSpecial xlPasteAll  'Past the entire row to the Database

        ActiveCell.Offset(1, 0).Select  'go down one row to prepare for next row

        ws1Row = ws1Row + 1

    Loop   'repeat

Next

Answer 2

对于偶然发现此问题的任何人，我都能找到我问题的答案。我使用find方法在工作表中搜索匹配项。在If语句下，我使用“无”条件将当前行复制到工作表的末尾。请参阅下面的解决方案。

If ws2.Range("D:D").Find(What:=ws1.Cells(ws1Row, 4).Text, _
        LookIn:=xlValues) Is Nothing Then
    ws1.Cells(ws1Row).EntireRow.Value = ws2.Cells(ws2LastRow + 1).Value

在2张纸之间搜索匹配项，如果找不到匹配项，则添加新行

2 个答案: