Aktualizuj i dołączaj wiersze na podstawie dwóch kryteriów w programie VBA Excel

Czy ktoś może mi pomóc napisać kod w języku VBA, który aktualizuje tabelę lub dołącza nowe dane na podstawie kryteriów w dwóch kolumnach?

Na przykład może istnieć kolumna nazwy i kolumna projektu, a my chcemy sprawdzić, czy Mark pracował nad projektem1. Jeśli Mark pracował nad projektem1, zaktualizuj swój wiersz o nowe dane z osobnego arkusza kalkulacyjnego. Jeśli Mark pracował nad projektem2 w osobnym arkuszu kalkulacyjnym, ale nie jest to udokumentowane w oryginalnym arkuszu kalkulacyjnym, dołącz Znak i projekt2 wraz z informacjami z tego wiersza. Jeśli Betty pracowała nad projektem1, a oryginalny arkusz zawiera te informacje, zaktualizuj ten wiersz. Jeśli Betty pracowała nad projektem2, ale oryginalny arkusz kalkulacyjny nie zawiera tych informacji, dodaj go jako nowy wiersz. Zatem nazwy i projekty będą się pojawiać wielokrotnie w tabeli, tylko z różnymi kombinacjami.

Chodzi więc o sprawdzenie obu kolumn w tym samym czasie i zaktualizowanie i dołączenie nowych danych.

Oto wadliwy kod, który mam teraz:

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

Dzięki!

Do tego typu wymagań używałbym dodatku Power Query Add-In. Posiada wiele funkcji do przekształcania danych, w tym scalania i dołączania. Budujesz swoje zapytanie w wizualnym interfejsie użytkownika, klikając przyciski (generuje kod) i widzi dane wynikowe na każdym kroku.

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 = USA

Próbowałem tego kodu, nie działa.

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

Potrzebujesz trochę więcej pomocy.