Excel-VBA-Makro-Zellen aus zwei verschiedenen Arbeitsmappen entsprechen und kopieren und entsprechend einfügen und nur die leeren Zellen

Question

Bitte helfen Sie mir in diesem ..

Ich habe zwei Arbeitsmappen Bookone.xlsm und Booktwo.xlsm zu aktualisieren, bookone wird die Quelle und booktwo ist die Ziel-Excel-Datei.

Bookone und Booktwo hat die folgenden Daten. Source and target excel file snapshot

Ich brauche nur die Zellen zu aktualisieren, die leer ist, aber alle Zellen werden immer einschließlich Nicht leere Zellen aktualisiert

Ausgabe meines VBA-Skript. Output

Vielen Dank im Voraus .. :)

Mein Code:

Sub UpdateW2() 

Dim w1 As Worksheet, w2 As Worksheet 
Dim c As Range, FR As Long 

Application.ScreenUpdating = False 

Set w1 = Workbooks("BookOne.xlsm").Worksheets("Sheet1") 
Set w2 = Workbooks("BookTwo.xlsm").Worksheets("Sheet1") 


For Each c In w1.Range("D2", w1.Range("D" & Rows.Count).End(xlUp)) 
    FR = 0 
    On Error Resume Next 
    FR = Application.Match(c, w2.Columns("A"), 0) 
    On Error GoTo 0 
    If FR <> 0 Then w2.Range("C" & FR).Value = c.Offset(, -3) 
    If FR <> 0 Then w2.Range("C" & FR).Value.Interior.ColorIndex=8 
Next c 
Application.ScreenUpdating = True 

End Sub

Answer 1

Du A die Werte aus w1 Spalte D in w2 Spalte suchen. Dort werden alle Werte gefunden, außer "Mach7". So werden alle Werte aktualisiert.

Sie möchten wahrscheinlich nur aktualisieren, wenn w2 Spalte C noch leer ist. Dann müssen Sie dies überprüfen.

Sub UpdateW2() 

Dim w1 As Worksheet, w2 As Worksheet 
Dim c As Range, FR As Variant 

Application.ScreenUpdating = False 

Set w1 = Workbooks("BookOne.xlsm").Worksheets("Sheet1") 
Set w2 = Workbooks("BookTwo.xlsm").Worksheets("Sheet1") 

For Each c In w1.Range("D2", w1.Range("D" & Rows.Count).End(xlUp)) 
    FR = Empty 
    FR = Application.Match(c, w2.Columns("A"), 0) 
    If TypeName(FR) <> "Error" Then 'match was found 
    If IsEmpty(w2.Range("C" & FR)) Then 'cell in w2 is still empty 
    w2.Range("C" & FR).Value = c.Offset(, -3) 
    w2.Range("C" & FR).Interior.ColorIndex = 8 
    End If 
    End If 
Next c 

Application.ScreenUpdating = True 

End Sub 

Im Gegensatz zu WorksheetFunction.Match, Application.Match werden nicht einen Fehler aus, wenn keine Übereinstimmung gefunden wird. Stattdessen wird ein Fehlerwert zurückgegeben. Also keine On Error... wird hier benötigt, wenn Sie DIM die FR als Variant. Dann können Sie überprüfen, FR, ob es ein Fehlerwert ist.