Wieder mal suchen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Abgleich() Dim rngMst As Range, _ rngNeu As Range Dim rngCMst As Range, _ rngCNeu As Range Dim varPMst As Variant, _ varPNeu As Variant Set rngMst = ThisWorkbook.Worksheets("Master").Cells(1, 1).CurrentRegion Set rngNeu = ThisWorkbook.Worksheets("Neu").Cells(1, 1).CurrentRegion If rngMst.Rows.Count

Hallo Peter,
ich hab auch mal versucht, das Makro von Ur-Opa nachzuvollziehen.
1. Er hat vergessen, die Hilfsspalte für die Formeln links von Spalte A in beiden Blättern einzufügen
2. Durch den 1. Fehler passt dann auch die Suche nach dem eindeutigen Code nicht, da Werte in den falschen Spalten verglichen werden.
3. Beim Einfügen von neuen Datensätzen von Neu nach Master ist er dann noch bei den Variablen durcheinander gekommen, so dass beim Kopieren eine schon vorhandene Zeile überschrieben werden soll, was zur Fehlermeldung führt.
Ich hab seinen Code angepasst plus das Färben der neuen Datensätze eingefügt, so dass er jetzt funktioniert.
ich hab dann auch noch eine Lösung ohne Hilfsspalten gebastelt. Hier wird dann im Makro mit Arrays gearbeitet in denen die Codes in Master und Neu verarbeitet werden.
LG
Franz
korrigierte Lösung von Ur-Opa

Sub Abgleich()
Dim rngMst As Range, _
rngNeu As Range
Dim rngCMst As Range, _
rngCNeu As Range
Dim varPMst As Variant, _
varPNeu As Variant
Set rngMst = ThisWorkbook.Worksheets("Master").Cells(1, 1).CurrentRegion
Set rngNeu = ThisWorkbook.Worksheets("Neu").Cells(1, 1).CurrentRegion
If rngMst.Rows.Count

Lösung ohne Hilfsspalten

'Code in einem allgemeinen Modul
Sub Update_Master()
Dim wksMaster As Worksheet, wksNeu As Worksheet
Dim arrNeu, arrCode, sCode As String, arrMaster
Dim Zeile_N As Long, Zeile_M As Long
Dim varZeile As Variant
Set wksNeu = ActiveWorkbook.Worksheets("Neu")
Set wksMaster = ActiveWorkbook.Worksheets("Master")
'Array mit Codes aus Daten in Spalten A bis C von Blatt "Neu" erstellen
arrCode = fncArrCode(wksNeu, Array(1, 2, 3))
With wksMaster
'Codea "Master" in Array einlesen
arrMaster = fncArrCode(wksMaster, Array(1, 2, 3))
'Codes im Master in Neu suchen
For Zeile_M = 2 To UBound(arrMaster)
sCode = arrMaster(Zeile_M)
varZeile = Application.Match(sCode, arrCode, 0)
If IsNumeric(varZeile) Then
'Code in Master ist in Neu vorhanden
wksNeu.Range(wksNeu.Cells(varZeile, 4), wksNeu.Cells(varZeile, 14)).Copy _
Destination:=.Cells(Zeile_M, 4)
Else
'Code in Master ist in Neu nicht vorhanden - durchstreichen
With .Range(.Cells(Zeile_M, 1), .Cells(Zeile_M, 14))
.Font.Strikethrough = True
End With
End If
Next
'Neue Codes mit Masterdaten vergleichen
For Zeile_N = 2 To UBound(arrCode)
sCode = arrCode(Zeile_N)
varZeile = Application.Match(sCode, arrMaster, 0)
If IsNumeric(varZeile) Then
'Zeile ist schon vorhanden - wurde aktualisiert
Else
'Einfüge-Zeile ermittel (Master-Liste muss aufsteigend sortiert sein!!!)
varZeile = Application.Match(sCode, arrMaster, 1)
If IsError(varZeile) Then varZeile = 1 'neuer Eintrag vor 1. Zeile
wksNeu.Range(wksNeu.Cells(Zeile_N, 1), wksNeu.Cells(Zeile_N, 14)).Copy
'kopierte Zellen einfügen
.Range(.Cells(varZeile + 1, 1), .Cells(varZeile + 1, 14)).Insert _
shift:=xlShiftDown
'eingefügte zeile grün färben
With .Range(.Cells(varZeile + 1, 1), .Cells(varZeile + 1, 14))
.Interior.Color = RGB(red:=0, green:=255, blue:=0)
End With
'Codes-Master neu berechnen
arrMaster = fncArrCode(wksMaster, Array(1, 2, 3))
End If
Next
End With
Erase arrMaster, arrCode
End Sub
Private Function fncArrCode(wks As Worksheet, arrSpalten, Optional sTrenn$ = "|", _
Optional Zeile1& = 1) As Variant
'Schlüsselwerte aus mehreren Spalten in einem 1-spaltigen Array zusammenfassen
Dim arrErgebnis() As String
Dim Spalte As Integer
Dim arrData
Dim Zeile_L As Long, Zeile As Long
With wks
'letzte Zeile mit Daten in den Spalten ermitteln
For Spalte = LBound(arrSpalten) To UBound(arrSpalten)
Zeile = .Cells(.Rows.Count, arrSpalten(Spalte)).End(xlUp).Row
If Zeile >= Zeile_L Then Zeile_L = Zeile
Next
'Daten in Tabelle in Array einlesen
arrData = .Range(.Cells(Zeile1, 1), .Cells(Zeile_L, arrSpalten(UBound(arrSpalten))))
ReDim arrErgebnis(Zeile1 To Zeile_L)
'Codes in Array schreiben mit Trennzeichen
For Zeile = Zeile1 To Zeile_L
arrErgebnis(Zeile) = arrData(Zeile, arrSpalten(LBound(arrSpalten)))
For Spalte = LBound(arrSpalten) + 1 To UBound(arrSpalten)
arrErgebnis(Zeile) = _
arrErgebnis(Zeile) & sTrenn & arrData(Zeile, arrSpalten(Spalte))
Next
Next Zeile
End With
fncArrCode = arrErgebnis
Erase arrErgebnis
End Function

'Master Nummer 2+3 weitersuchen If Not rFind Is Nothing Then With rFind: flg = Empty 'Schleife zum Suchen aller Daten For j = 1 To 100 If AC.Value .Cells(j, 1) Then flg = "No": Exit For If Num2 = .Cells(j, 2) And Num3 = .Cells(j, 3) Then .Cells(j, 4).Resize(1, 14).Copy AC.Offset(0, 3).PasteSpecial xlPasteValues Application.CutCopyMode = False Exit For End If Next j End With End If

'Master Nummer 2+3 weitersuchen If Not rFind Is Nothing Then With rFind: flg = Empty 'Schleife zum Suchen aller Daten For j = 1 To 100 If AC.Value .Cells(j, 1) Then flg = "No": Exit For If Num2 = .Cells(j, 2) And Num3 = .Cells(j, 3) Then .Cells(j, 4).Resize(1, 14).Copy AC.Offset(0, 3).PasteSpecial xlPasteValues Application.CutCopyMode = False ' ZeileNeu = rFind.Row + j - 1 'in Spalte 20 von Master für Spalte 10 die Differenz zu Neu eintragen AC.Offset(0, 19).Value = rFind.Offset(j - 1, 9).Value - AC.Offset(0, 9).Value Exit For End If Next j End With End If

Hallo Peter,
Sorry, ich hatte nicht erwähnt, dass ich links (Spalte A) eine Hilfsspalte für die verketteten Schlüssel eingefügt hatte. Daher kommen auch die nachfolgenden Probleme.
Die Hilfsspalte muss nicht unbedingt immer wieder hinzugefügt oder gelöscht werden. Es reicht, wenn man die Spalte ausblendet.
Der Unterschied zu der Lösung von Piet liegt darin, dass ich konsequent Variablen verwende, die Bereiche im Arbeitsplatz repräsentieren, also Bereichs-Objekte bzw. Range-Objekte, einsetze.
Die Bereiche rngMst und rngNeu enthalten nach der Resize-Anweisung alle Master- bzw. Neu-Daten ohne Header.
Dann werden alle Zellen in der ersten (der Hilfsspalte) mit einer Formel nach der Z1S1-Notation gefÜllt. Z1S1 bedeutet, dass die Bezüge nicht mit A1, A2 etc., sondern Zeile 1/Spalte 1 etc adressiert werden. RC[1] adressiert eine Zelle in der gleichen Zeile eine Spalte rechts.
Durch die Verwendung der Range-Objekte ist es möglich, die Formel in alle Zellen der ersten Spalte des Ranges gleichzeitig einzutragen, ohne zu kopieren.
Die Range-Objekte rngCMst und rngCNeu nehmen einzelne Datenzeilen auf.
Sie dienen hauptsächlich als Laufvariable in den For-Next-Schleifen. Damit spart man sich die Verwaltung von nummerischen Indizes (z.B. For x = 1 to 10).
Statt der Find-Methode verwende ich mit Application.Match die VERGLEICH-Funktion aus dem Excel.
Als Ergebnis erhält man in varPMst bzw. varPNeu entweder einen Fehlerzustand oder die Zeilennummer, in der der entsprechende Schlüssel gefunden wurde.
Ich hoffe, diese Erläuterungen machen das Konzept etwas klarer.
Am besten den Makro einmal schrittweise ausführen und im Überwachungsfenster z.B. die
Adressen der Bereichs-Objekte überwachen.
Es lohnt sich, konsequent mit Objekten zu arbeiten, wie z.B.Range-Ojekten.
Damit stehen sehr vielfältige und mächtige Werkzeuge zur Verfügung und Code sieht "cool" aus.
An dieser Stelle noch herzlichen Dank an fcs für die Fehlerbereinigung.
Schönen Sonntag noch
Ur-Opa

Beliebteste Forumthreads (12 Monate)

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread