VBA für Zellenabgleich und div. Operationen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: VBA für Zellenabgleich und div. Operationen
von: Adrian
Geschrieben am: 23.07.2015 16:28:33

Hallo Community!
Ich stehe auf der Arbeit grad vor folgendem Problem:
Und zwar habe ich 2 Tabellenblätter (Quelle und Ziel) die ich möglichst in einem Abwasch
1.) auf bereits vorhandene vorgangsnummern (in beiden Blättern im Bereich A2 bis letzte Zeile mit Inhalt) vergleichen und falls nicht in "Ziel" vorhanden aus "Quelle" kopieren und am besten in eine frisch eingefügte Zeile in "Ziel" hinte rdem letzten Eintrag einfügen möchte, und
2.) Wenn Vorgangsnummer bereits in beiden Blättern vorhanden, bei Spalten "S" und "W" die Einträge aus "Quelle" mit "Ziel" vergleichen und bei änderung die Werte übernehmen und farbig in "Ziel" hervorheben
3.) Datensätze, die zwar noch in "Ziel" sind, aber nicht mehr in "Quelle", einfach grau zu hinterlegen...
Ich habe mir dazu bisher folgendes zusammengegaunert :D


Option Explicit
Sub Abgleich()
Dim DupliArr As Variant, MasterArr As Variant, LZ1 As Long, LZ2 As Long, ZeileD As Long, ZeileU  _
 _
 _
 _
As Long, ZeileE As Long, ZeileV As Long, sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets(2)
Set sh2 = Sheets(1)
LZ1 = IIf(IsEmpty(sh1.Cells(sh1.Rows.Count, 1)), sh1.Cells(sh1.Rows.Count, 1).End(xlUp).Row,  _
sh1.Rows.Count) 'Quellbereich
LZ2 = IIf(IsEmpty(sh2.Cells(sh2.Rows.Count, 1)), sh2.Cells(sh2.Rows.Count, 1).End(xlUp).Row,  _
sh2.Rows.Count) 'Zielbereich
DupliArr = sh1.Range("A2:A" & LZ1)
MasterArr = sh2.Range("A2:A" & LZ2)
sh2.Range("A2:A" & LZ2).Interior.ColorIndex = 0 'sauber machen
sh2.Range("S2:S" & LZ2).Interior.ColorIndex = 0
sh2.Range("W2:W" & LZ2).Interior.ColorIndex = 0
For ZeileD = 2 To LZ1
    For ZeileU = 2 To LZ2
        If sh1.Cells(ZeileD, 1).Value = sh2.Cells(ZeileU, 1).Value And sh1.Cells(ZeileD, 19). _
Value <> sh2.Cells(ZeileU, 19).Value Then        'vergleich 
            sh1.Rows(ZeileD).Copy sh2.Rows(ZeileU)
            
            sh2.Cells(ZeileU, 19).Interior.ColorIndex = 3
        End If
    Next ZeileU
Next ZeileD
Dim rngQuelle As Range
Dim rngZiel As Range
  For Each rngZiel In sh2.Range("A2:A" & LZ2)
    On Error Resume Next
    Set rngQuelle = sh1.Range("A2:A" & LZ2).Find(What:=rngZiel)
    On Error GoTo 0
    If Not rngQuelle Is Nothing Then
      rngQuelle.EntireRow.Copy
      rngZiel.EntireRow.PasteSpecial Paste:=xlPasteValues
    End If
Next
End Sub

Die Erste Schleife haut schon ganz gut hin, bis auf die Tatsache, dass nur eine Änderung in der betreffenden Zeile farbig wird (vllt. muss da mit Range hantiert werden, als die komplette row zu vergleichen?)
Die zweite schleife läuft ohne Debug durch, bewirkt aber keine Veränderung in den Tabellen...
Großartig wäre außerdem, wenn man vor der Ausführung des eigentlichen Makros eine Abfrage starten könnte, die zumindest die "Quelle" (eigentlich aus jeweils verschiedenen workbooks stammend) von einem beliebigen ort auf der Festplatte laden kann...
sowas wie:

Public Sub Update()
Dim var As Variant
MsgBox "Please locate the new extracts.", vbInformation
ChDrive "P:"
ChDir "\QUALITY\CABCARGOQUALITY\040_QECM\080_KSI Mod efficiency\030_EC Filtered lists ( _
alignment)"
var = Application.GetOpenFilename("Excel-Dateien (*.xls; *.xlsx),*.xlsx; *.xls", MultiSelect:=   _
_
_
False)
    
If var = False Then
MsgBox "No File selected, exiting."
Exit Sub
Else
    Workbooks.Open var
    
End If
End Sub

Bitte um Hilfe :-)
LG
Adrian

Bild

Betrifft: AW: VBA für Zellenabgleich und div. Operationen
von: Adrian
Geschrieben am: 24.07.2015 09:52:42
Kann keiner helfen? :(
Vorerst reichte es mir schon, eine Lösung für Copy/Paste-Prozedur zu finden, die nur die neuen Einträge in die vorhandene "Ziel" Datei überträgt... Ich habe mit der Schleife noch irgendwie meine Probleme:


For ZeileD = 2 To LZ1
    For ZeileU = 2 To LZ2
        If sh1.Cells(ZeileD, 1).Value <> sh2.Cells(ZeileU, 1).Value And sh1.Cells(ZeileD, 1). _
Value <> "" Then       'insert new
           
            sh2.Range("A2").End(xlDown).Offset(1, 0).EntireRow.Insert
            sh1.Rows(ZeileD).Copy Destination:=sh2.Rows(ZeileU)
            
           sh2.Cells(ZeileU, 1).Interior.ColorIndex = 2
        End If
    Next ZeileU
Next ZeileD
Dieser Code läuft auch durch, macht aber nicht das was er soll^^ Ich nimmt nur den Inhalt der letzten Reihe in "Quelle" und schmeisst ihn einfach in jede Zelle des "Ziels"... Ich sehe einfach kein Land mehr :-(

 Bild

Beiträge aus den Excel-Beispielen zum Thema "bedingte Formatierung aufgrund e. Variablenwertes"