☰

在 VBA Excel 中根据两个条件更新并附加行

tag-icon • tag-icon microsoft-excel vba
在 VBA Excel 中根据两个条件更新并附加行

有人能帮我用 VBA 编写一个代码来更新表格或根据两列中的条件附加新数据吗？

例如，可能有一个名称列和一个项目列，我们想检查 Mark 是否参与了项目 1。如果 Mark 参与了项目 1，则使用来自单独电子表格的新数据更新他的行。如果 Mark 在单独的电子表格中参与了项目 2，但原始电子表格中没有记录，则附加 Mark 和项目 2，以及该行的信息。如果 Betty 参与了项目 1，并且原始电子表格中有此信息，则更新此行。如果 Betty 参与了项目 2，但原始电子表格没有此信息，则将其附加为新行。因此，名称和项目都会在表中出现多次，只是组合不同。

因此，我们的想法是同时检查两列，并相应地更新和附加新数据。

这是我现在的错误代码：

Dim filename As String
Dim ManagerLEs As Workbook
Dim ProjectLEs As Workbook
Set ProjectLEs = ThisWorkbook

filename = Application.GetOpenFilename("Word files (*.xlsx),*.xlsx", , "Browse for file containing table to be imported")

If filename = Empty Then
    Exit Sub
End If

Set ManagerLEs = Application.Workbooks.Open(filename)

Dim first_blank_row As Long
first_blank_row = Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row
starting_row = 4

Dim r As Long

r = starting_row

Dim namefound As Range
Dim projectfound As Range

firstname = ManagerLEs.ActiveSheet.Range("a" & r).Value
projectname = ManagerLEs.ActiveSheet.Range("d" & r).Value

Do While firstname <> 0

Set namefound = Columns("a:a").Find(what:=firstname, LookIn:=xlValues, lookat:=xlWhole)
Set projectfound = Columns("d:d").Find(what:=projectname, LookIn:=xlValues, lookat:=xlWhole)

    'look for current ticket number in main file
    If (namefound Is Nothing And projectfound Is Nothing) Then

        'add info to end of main file
        For c = 1 To 57
        ProjectLEs.Worksheets("Template").Cells(first_blank_row, c) = ManagerLEs.Worksheets("LEs").Cells(r, c)
        first_blank_row = first_blank_row + 1
        Next c
    Else

        'overwrite existing line of main file
        For c = 1 To 57
        ProjectLEs.Worksheets("Template").Cells(namefound.Row, c) = ManagerLEs.Worksheets("LEs").Cells(r, c)
        Next c
    End If

        r = r + 1
        firstname = ManagerLEs.ActiveSheet.Range("a" & r).Value
        projectname = ManagerLEs.ActiveSheet.Range("d" & r).Value
Loop

谢谢！

答案1

对于这种需求，我会使用 Power Query 插件。它有许多转换数据的功能，包括合并和追加。您可以通过单击按钮在可视化 UI 中构建查询（它会生成代码），并且可以在每个步骤中看到结果数据。

https://support.office.com/en-us/article/Microsoft-Power-Query-for-Excel-Help-2b433a85-ddfb-420b-9cda-fe0e60b82a94?ui=en-US&rs=en-001&ad=US

答案2

试过这个代码，不起作用。

Sub importLEs()

With Excel.Application
    .ScreenUpdating = False
    .Calculation = Excel.xlCalculationManual
    .EnableEvents = False
End With

Dim filename As String
Dim ManagerLEs As Workbook
Dim ProjectLEs As Workbook
Set ProjectLEs = ThisWorkbook

'open file that you are importing data from
filename = Application.GetOpenFilename("Word files (*.xlsx),*.xlsx", , "Browse for file containing table to be imported")

If filename = Empty Then
    Exit Sub
End If

Set ManagerLEs = Application.Workbooks.Open(filename)

Dim first_blank_row As Long

first_blank_row = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
starting_row = 4

Dim r As Long
Dim rr As Long

r = starting_row
rr = 4

firstname = ManagerLEs.ActiveSheet.Range("a" & r).Value
projectname = ManagerLEs.ActiveSheet.Range("d" & r).Value
mastername = ProjectLEs.Worksheets("Template").Range("a" & rr).Value
masterproject = ProjectLEs.Worksheets("Template").Range("d" & rr).Value

Do While firstname <> 0

    'counter to check if a row is updated
    flag = False

    Do While mastername <> 0

        If mastername = firstname And masterproject = projectname Then

            'update existing line of main file
            For c = 10 To 57
            ProjectLEs.Worksheets("Template").Cells(rr, c) = ManagerLEs.Worksheets("LEs").Cells(r, c)
            Next c
            flag = True
            Exit Do

        End If

    Loop

        'if data does not exist, append data to the end of main file
        If flag = False Then

            For c = 1 To 57
            ProjectLEs.Worksheets("Template").Cells(first_blank_row, c) = ManagerLEs.Worksheets("LEs").Cells(r, c)
            Next c

        End If

        first_blank_row = first_blank_row + 1
        rr = rr + 1
        r = r + 1
        firstname = ManagerLEs.ActiveSheet.Range("a" & r).Value
        projectname = ManagerLEs.ActiveSheet.Range("d" & r).Value
        mastername = ProjectLEs.Worksheets("Template").Range("a" & rr).Value
        masterproject = ProjectLEs.Worksheets("Template").Range("d" & rr).Value

Loop

With Excel.Application
    .ScreenUpdating = True
    .Calculation = Excel.xlAutomatic
    .EnableEvents = True
End With

End Sub

需要更多帮助。

相关内容