Wieder mal suchen

Peter · 2016-11-19T18:18:36+00:00

Hi alle, ich kreise nun schon einige Zeit um das folgende Problem (siehe auch Anhang https://www.herber.de/bbs/user/109556.xlsm): In einer "Master" Excel Sheet habe ich eine Liste, welche ich von Zeit zu Zeit aktualisieren möchte. Die neuen Daten sind in dem Sheet "Neu". Der Einfachheit halber habe ich nur das eigentliche Grundproblem in dies Exceldatei kopiert. Es soll nun folgendes gemacht werden: - Der Eintrag im "Master" Sheet soll im "Neu" Sheet gesucht werden. Problem hierbei ist, dass alle drei Zellen (Nummer 1 - 3) überein stimmem müssen. Wird eine Übereinstimmung gefunden, dann soll die Zeile in "Master" mit der von "Neu" aktualisiert werden (das ist nun hier natürlich nicht sichtbar, die Werte befinden sich in den Spalten ab 4 bis 14, das kopieren kriege ich aber hin... ;-)). Ich schaffe es, mit der .find Methode die erste Zahl "Nummer1" zu finden, aber ich bin ratlos, wie ich die nächsten Zahlen finden soll... - Wird der Eintrag im "Master" in "Neu" nicht gefunden, dann ist er alt und soll durchgestrichen dargestellt werden. Danach muss ich noch von "Neu" nach "Master" suchen, da ja auch neue Nummern hinzugekommen sein können. Diese müssen dann von "Neu" in "Master" hineinkopiert werden (und grün markiert werden). Ein paar Beispiele, wie das im Excel Sheet umgesetzt werden müsste: 1) Die Zeilen 2 - 9 und 11 - 13 sind im Sheet "Neu" nicht vorhanden und sollen durchgestrichen werden. 2) Die Zeile 10 ist vorhanden und wird belassen (im finalen Excel aktualisiere ich hier die Daten) 3) Die Zeile 3 ist im Sheet "Neu", aber nicht im Sheet "Master" und soll daher in das Sheet "Master" kopiert werden, und zwar zwischen die Zeilen 10 und 11. So, ich hoffe ich konnte verdeutlichen, was ich machen will. Bin wirklich dankbar für jede Hilfe... Viele Grüße, Peter

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

Hi Franz,
voll krass :-), vielen Dank.
Ich habe bis eben gebraucht, Deine Lösung in mein anderes Excel zu integrieren... :-)
Aber ich glaube, dass ich das meiste hinbekommen habe. *thumbs up*
Es hat länger gedauert, weil ich noch eine Progress Bar eingebaut habe, welche mir den Fortschritt anzeigt, da das Makro ja doch ein wenig länger dauert...
Dann habe ich noch versucht, das sortieren von Ur-Opa einzufügen - tut aber (noch) nicht.
Sobald ich Apply anwende, kommt ein "Laufzeitfehler 1004": "Der Sortierbezug ist ungültig. Überprüfen Sie, ob sich der Sortierbezug innerhalb der markierten Daten befindet und ob das Feld "Sortieren nach" nicht den gleichen Bezug enthält oder leer ist."
Habe mir das Sortieren aber noch nicht sooo genau angeschaut.
Ich werde mir jetzt dann mal den von Dir korrigierten Code von Ur-Opa anschauen... Könnte aber ein Weilchen dauern, da ich nicht soooo fit im VBA bin... :-)
Ich habe noch eine Frage zu Deinem ursprünglichen Code:
In dem Abschnitt:

   '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

Hier kopierst Du die Daten von Neu nach Master, also z. B. von Zeile 50 in "neu" in Zeile 30 in "Master". Wie kann ich heraus finden, welche Zeile im Tabellenblatt "Neu" aktuell kopiert wird (im Beispiel wäre das Zeile 50)? Ich würde nämlich gerne eine Berechnung in der Zelle im Master und der entsprechenden Zelle in "Neu" durchführen. Ich will quasi den Wert der einen Zelle im "Master" (Zeile 30, Spalte 10) von dem Wert in "Neu" (Zeile 50, Spalte 10) abziehen und in den "Master" (an eine Stelle janz weit draußen... also rechts (Zeile 30, Spalte 20)) kopieren.
Nochmals danke und Gruß,
Peter

Forumthread: Wieder mal suchen

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Wieder mal suchen

Forumthread: Wieder mal suchen

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread