Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Gegenüberstellen von Werten mit Leerzeilen

Gegenüberstellen von Werten mit Leerzeilen
01.02.2007 16:46:47
Werten
Hallo,
ich habe folgendes Problem:
Ich habe Lifo-Werte aus 2005 und 2006 welche ich gerne gegenüberstellen möchte.
Nun kann es sein, daß ich in einem der beiden Jahre einen Artikel nicht hatte.
So müsste die entsprechend Seite mit einer Leerzeile aufgefüllt werden, damit man die Artikel besser vergleichen.
Wenn mir jemand zeitnah helfen könnte, wäre ich sehr dankbar.
Ich wäre ich müsste es nicht manuell machen, da die Liste 13000 Einträge hat und ich ein wenig unter Zeitdruck stehen.
Beispieldatei
https://www.herber.de/bbs/user/40070.xls
Gruß
Sascha
Anzeige

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Gegenüberstellen von Werten mit Leerzeilen
02.02.2007 13:11:30
Werten
Hallo Sascha,
da deine Beispieldatei ziemlich wenig Daten enthält konnte ich nicht viel testen, aber bei mir tuts es dieses Makro.
In das VBA Fenster übertragen, das Blatt mit den Daten aufrufen und testen.
Sollte sich das Makro aufhängen, kann man es mit der ESC oder STRG + PAUSE unterbrechen.
Test natürlich erstmal mit einer Datei-Kopie ;-)

Sub AuffuellenT()
Dim lngI As Long
Dim rngFind As Range
lngI = 2
With ActiveSheet
Do
If Trim(.Cells(lngI, 1).Text) <> Trim(.Cells(lngI, 3).Text) And _
.Cells(lngI, 1).Text <> "" And .Cells(lngI, 3).Text <> "" Then
Set rngFind = Range("C1:C" & .UsedRange.Rows.Count).Find(.Cells(lngI, 1), LookIn:=xlValues)
If rngFind Is Nothing Then
Set rngFind = Range("A1:A" & .UsedRange.Rows.Count).Find(.Cells(lngI, 3), LookIn:=xlValues)
If Not rngFind Is Nothing Then
.Range("C" & lngI & ":D" & .UsedRange.Rows.Count).Copy Destination:=.Range("C" & rngFind.Row)
.Range("C" & lngI & ":D" & rngFind.Row - 1).ClearContents
lngI = rngFind.Row - 1
End If
Else
Set rngFind = Range("C1:C" & .UsedRange.Rows.Count).Find(.Cells(lngI, 1), LookIn:=xlValues)
If Not rngFind Is Nothing Then
.Range("A" & lngI & ":B" & .UsedRange.Rows.Count).Copy Destination:=.Range("A" & rngFind.Row)
.Range("A" & lngI & ":B" & rngFind.Row - 1).ClearContents
lngI = rngFind.Row - 1
End If
End If
End If
lngI = lngI + 1
Loop Until lngI > .UsedRange.Rows.Count
MsgBox " Fertig ! "
End With
End Sub

Gruß Heiko
PS: Rückmeldung wäre nett !
Anzeige
AW: Gegenüberstellen von Werten mit Leerzeilen
02.02.2007 13:48:24
Werten
Hallo Heiko,
vielen Dank.
Hat mir super viel geholfen, so komme ich noch rechzeitig ins Wochenende.
Danke
Sascha
AW: Gegenüberstellen von Werten mit Leerzeilen
02.02.2007 14:02:38
Werten
Hallo Sascha,
hier nochmal ne verbesserte Version, läuft zumindest bei meiner Testdatei sehr viel zuverlässiger, kannst ja nochmal testen.

Sub AuffuellenT()
Dim lngI As Long, lngN As Long
Dim rngFind As Range
Application.ScreenUpdating = False
lngI = 2
lngN = 0
With ActiveSheet
Do
If Trim(.Cells(lngI, 1).Text) <> Trim(.Cells(lngI, 3).Text) And _
.Cells(lngI, 1).Text <> "" And .Cells(lngI, 3).Text <> "" Then
Set rngFind = Range("C1:C" & .UsedRange.Rows.Count).Find(Trim(.Cells(lngI, 1)), LookIn:=xlValues)
If rngFind Is Nothing Then
Set rngFind = Range("A1:A" & .UsedRange.Rows.Count).Find(Trim(.Cells(lngI, 3)), LookIn:=xlValues)
If Not rngFind Is Nothing Then
.Range("C" & lngI & ":D" & .UsedRange.Rows.Count).Copy Destination:=.Range("C" & rngFind.Row)
.Range("C" & lngI & ":D" & rngFind.Row - 1).ClearContents
lngN = lngN + 1
Else
.Range("C" & lngI & ":D" & .UsedRange.Rows.Count).Copy Destination:=.Range("C" & lngI + 1)
.Range("C" & lngI & ":D" & lngI).ClearContents
lngN = lngN + 1
End If
Else
Set rngFind = Range("C1:C" & .UsedRange.Rows.Count).Find(Trim(.Cells(lngI, 1)), LookIn:=xlValues)
If Not rngFind Is Nothing Then
.Range("A" & lngI & ":B" & .UsedRange.Rows.Count).Copy Destination:=.Range("A" & rngFind.Row)
.Range("A" & lngI & ":B" & rngFind.Row - 1).ClearContents
lngN = lngN + 1
End If
End If
End If
lngI = lngI + 1
Loop Until lngI > .UsedRange.Rows.Count
MsgBox "Fertig ! Es wurden " & lngN & " Aktionen ausgeführt !", vbInformation
End With
Application.ScreenUpdating = True
End Sub

Gruß Heiko
PS: Rückmeldung wäre nett !
Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige