Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
Anzeige
Archiv - Navigation
840to844
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
840to844
840to844
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

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

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

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige