Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 18:41:19
vba Zeilen duplizieren ab aktiver Zeile bis letzte Zeile
25.04.2024 18:22:55
Zeilen mit bestimmtem Datum in andere Mappe übertragen
25.04.2024 18:14:45
VBA - Excell - Kopie und "Diebstahl" Schützen
25.04.2024 17:49:39
Bedingte Formatierung
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
792to796
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
792to796
792to796
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Datenabgleich - Leerzeilen einfügen

Datenabgleich - Leerzeilen einfügen
23.08.2006 15:32:55
Thorsten
Hallo Experten.
Ich habe verschiedene Tabellen mit jeweils 2 Datenbereichen:
Bereich 1 beginnt in A3 und geht bis Spalte E (Anzahl der Zeilen unterschiedlich)
Bereich 2 beginnt in G3 und geht bis Spalte K (Anzahl der Zeilen unterschiedlich)
Nun soll über ein Makro ein Abgleich stattfinden. Es Soll die Zahl in Spalte A mit der in Spalte G verglichen werden. Zeile für Zeile... sofern identisch ist alles ok.
Ist der Wert in einer Zeile in Spalte A größer als der in der gleichen Zeile in Spalte G soll im Bereich 1 eine Leerzeile eingefügt werden. Ist der Wert kleiner, dann im Bereich 2. Am Ende sollen in den Zeilen immer gleiche Datensätze stehen.
Hierfür brauche ich eure Hilfe. Danke

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datenabgleich - Leerzeilen einfügen
23.08.2006 15:35:02
Thorsten
Eine Anmerkung noch. In die jeweilige Spalte (A oder G) der Leerzeile soll dann der dazugehörige Wert geschrieben werden.
AW: Datenabgleich - Leerzeilen einfügen
23.08.2006 15:42:15
Thorsten
Sorry... noch etwas... wenn eine Leerzeile eingefügt wird (egal welcher Bereich) muss diese auch im Bereich M-Q eingefügt werden.
AW: Datenabgleich - Leerzeilen einfügen
24.08.2006 08:18:38
Heide_Tr
hallo Thorsten,
falls die Spalten B-E und H-K gleich sind (wenn A=G) könnte man einfach die Listen hintereinander hängen, dann Spezialfilter ohnd Duplikate...
andernfalls über dieses Makro:

Sub Ergaenzen()
Dim Erg() As Variant, OrgA() As Variant, OrgG() As Variant
Dim ErgZ As Long, zA As Long, zG As Long
ErgZ = 1
zA = 1
zG = 1
OrgA = Range("A3:E" & Range("A65536").End(xlUp).Row)
OrgG = Range("G3:K" & Range("E65536").End(xlUp).Row)
ReDim Erg(UBound(OrgA, 1) + UBound(OrgG, 1), 10)
Do Until zA > UBound(OrgA) Or zG > UBound(OrgG)
Select Case OrgA(zA, 1)            'A
Case Is = OrgG(zG, 1)            ' A = G
For j = 1 To 5
Erg(ErgZ, j) = OrgA(zA, j)
Erg(ErgZ, j + 5) = OrgG(zG, j)
Next j
zA = zA + 1
zG = zG + 1
Case Is > OrgG(zG, 1)            ' A > G
For j = 1 To 5
Erg(ErgZ, j) = OrgG(zG, j)
Erg(ErgZ, j + 5) = OrgG(zG, j)
Next j
zG = zG + 1
Case Else                         ' A < G
For j = 1 To 5
Erg(ErgZ, j) = OrgA(zA, j)
Erg(ErgZ, j + 5) = OrgA(zA, j)
Next j
zA = zA + 1
End Select
ErgZ = ErgZ + 1
Loop
Application.ScreenUpdating = False
Range("A3:K" & ErgZ + 2).Delete
For zA = 1 To ErgZ - 1
For j = 1 To 5
Cells(zA + 2, j) = Erg(zA, j)
Cells(zA + 2, j + 6) = Erg(zA, j + 5)
Next j
Next zA
Application.ScreenUpdating = True
End Sub

viele Grüße. Heide
Anzeige
AW: Datenabgleich - Leerzeilen einfügen
24.08.2006 08:59:59
Thorsten
War schon richtig verstanden - die Daten dahinter sind unterschiedlich. Deshalb das Makro. Funktioniert super. Könnte man da jetzt noch etwas einbauen? Es kann vorkommen, dass in den Bereichen manchmal 0-Werte oder Felder leer sind. Allerdings nur die Bereiche B-E und H-K. Sollte in beiden Bereichen dieses vorkommen, soll die ganze Zeile gelöscht werden. Also diese Funktion soll nach der Ersten (Ergänzung) ausgeführt werden.
AW: Datenabgleich - Leerzeilen einfügen
24.08.2006 09:56:24
Heide_Tr
hallo Thorsten,
dann so:

Sub ErgaenzGn()
Dim Erg() As Variant, OrgA() As Variant, OrgG() As Variant
Dim ErgZ As Long, zA As Long, zG As Long, zz As Long
ErgZ = 1
zA = 1
zG = 1
OrgA = Range("A3:E" & Range("A65536").End(xlUp).Row)
OrgG = Range("G3:K" & Range("E65536").End(xlUp).Row)
ReDim Erg(UBound(OrgA, 1) + UBound(OrgG, 1), 10)
Do Until zA > UBound(OrgA) Or zG > UBound(OrgG)
Select Case OrgA(zA, 1)            'A
Case Is = OrgG(zG, 1)            ' A = G
For j = 1 To 5
Erg(ErgZ, j) = OrgA(zA, j)
Erg(ErgZ, j + 5) = OrgG(zG, j)
Next j
zA = zA + 1
zG = zG + 1
Case Is > OrgG(zG, 1)            ' A > G
For j = 1 To 5
Erg(ErgZ, j) = OrgG(zG, j)
Erg(ErgZ, j + 5) = OrgG(zG, j)
Next j
zG = zG + 1
Case Else                         ' A < G
For j = 1 To 5
Erg(ErgZ, j) = OrgA(zA, j)
Erg(ErgZ, j + 5) = OrgA(zA, j)
Next j
zA = zA + 1
End Select
ErgZ = ErgZ + 1
Loop
Application.ScreenUpdating = False
Range("A3:K" & ErgZ + 2).Delete
zz = 3
For zA = 1 To ErgZ - 1
If WorksheetFunction.Sum(Len(Erg(zA, 2)), Len(Erg(zA, 3)), Len(Erg(zA, 4)), Len(Erg(zA, 5)), _
Len(Erg(zA, 7)), Len(Erg(zA, 8)), Len(Erg(zA, 9)), Len(Erg(zA, 10))) > 0 Then
For j = 1 To 5
Cells(zz, j) = Erg(zA, j)
Cells(zz, j + 6) = Erg(zA, j + 5)
Next j
zz = zz + 1
End If
Next zA
Application.ScreenUpdating = True
End Sub

viele Grüße. Heide
p.s.: Anrede und Gruß wären eigentlich ganz nett gewesen.
Anzeige
AW: Datenabgleich - Leerzeilen einfügen
24.08.2006 10:19:25
Thorsten
Hallo Heide.
Zunächst einmal vielen Dank. Irgendwie passiert nichts anderes jetzt bei mir. Also in den Zeilen der Spalten A und G stehen immer Werte. Aber die dazughörigen Spalten B-E und H-k können 0-Werte (im Format o oder 0,000) oder Leerzeilen enthalten. Wenn in beiden Bereichen dies der Fall ist, soll die dazugehörige Zeile gelöscht werden. Das ganze nachem zunächst die Zeilenergänzung gelaufen ist.
Danke.
AW: Datenabgleich - Leerzeilen einfügen
24.08.2006 11:09:31
Thorsten
Wenn ich mich nicht täusche habe ich beim ersten Part des Abgleichs nun doch noch ein Problem. Das funktioniert soweit ja ganz gut, aber... wenn in A nichts mehr ist und in G noch Zeilen mit Datensätzen folgen werden die ignoriert. Die Anzahl der Datensätze in beiden Bereichen ist ja leider nicht identisch. In diesem Fall muss natürlich der Wert aus G in A eingefügt werden.
Anzeige
AW: Datenabgleich - Leerzeilen einfügen
24.08.2006 12:43:24
Heide_Tr
hallo Thorsten,
ja das stimmt, in meinem letzten Code wurde die jeweils Letzten nicht verarbeitet. Sorry.
Falls die Spalten B-E und H-K nur Zahlen beinhalten, funktioniert das Löschen nun auch, wenn die Zellen 0 enthalten. Können sie auch Buchstaben beinhalten, müßte man Len und Sum kombinieren.
viele Grüße Heide

Sub Ergaenzen()
Dim Erg() As Variant, OrgA() As Variant, OrgG() As Variant
Dim ErgZ As Long, zA As Long, zG As Long, zz As Long
ErgZ = 1
zA = 1
zG = 1
OrgA = Range("A3:E" & Range("A65536").End(xlUp).Row)
OrgG = Range("G3:K" & Range("G65536").End(xlUp).Row)
ReDim Erg(UBound(OrgA, 1) + UBound(OrgG, 1), 10)
Do Until zA > UBound(OrgA) Or zG > UBound(OrgG)
Select Case OrgA(zA, 1)            'A
Case Is = OrgG(zG, 1)            ' A = G
For j = 1 To 5
Erg(ErgZ, j) = OrgA(zA, j)
Erg(ErgZ, j + 5) = OrgG(zG, j)
Next j
zA = zA + 1
zG = zG + 1
Case Is > OrgG(zG, 1)            ' A > G
For j = 1 To 5
Erg(ErgZ, j) = OrgG(zG, j)
Erg(ErgZ, j + 5) = OrgG(zG, j)
Next j
zG = zG + 1
Case Else                         ' A < G
For j = 1 To 5
Erg(ErgZ, j) = OrgA(zA, j)
Erg(ErgZ, j + 5) = OrgA(zA, j)
Next j
zA = zA + 1
End Select
ErgZ = ErgZ + 1
Loop
Do While zA <= UBound(OrgA)
For j = 1 To 5
Erg(ErgZ, j) = OrgA(zA, j)
Erg(ErgZ, j + 5) = OrgA(zA, j)
Next j
zA = zA + 1
ErgZ = ErgZ + 1
Loop
Do While zG <= UBound(OrgG)
For j = 1 To 5
Erg(ErgZ, j) = OrgG(zG, j)
Erg(ErgZ, j + 5) = OrgG(zG, j)
Next j
zG = zG + 1
ErgZ = ErgZ + 1
Loop
Application.ScreenUpdating = False
Range("A3:K" & ErgZ + 2).Delete
zz = 3
For zA = 1 To ErgZ - 1
If WorksheetFunction.Sum(Erg(zA, 2), Erg(zA, 3), Erg(zA, 4), Erg(zA, 5), _
Erg(zA, 7), Erg(zA, 8), Erg(zA, 9), Erg(zA, 10)) > 0 Then
For j = 1 To 5
Cells(zz, j) = Erg(zA, j)
Cells(zz, j + 6) = Erg(zA, j + 5)
Next j
zz = zz + 1
End If
Next zA
Application.ScreenUpdating = True
End Sub

Anzeige
Fast fertig...
24.08.2006 12:57:20
Thorsten
Hallo Heide.
Das mit dem zusätzlichen Löschen funktioniert nun auch super. Allerdings habe ich noch das bereits geschilderte Problem, dass mir die letzten Datensätze verlorengegangen sind. Wenn ich es richtig sehe, liegt es wohl daran, dass der zweite Vergleichsblock G-K z.T. auch mehr Zeilendatesätze haben kann als der Erste. In diesem Fall müssten die Zeilen auch in den ersten Block (A-E) mit eingefügt werden. Derzeit werden sie einfach gelöscht. Kann leider keine Datei hochladen, sonst könntest ein Beispiel sehen. Hoffe aber, es war verständlich. Vielen Dank nochmals für deine ganzen Mühen.
Anzeige
Sorry!!!
24.08.2006 13:00:40
Thorsten
Läuft nun doch richtig. Habe mich gerade selbst ausgetrickst...

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige