Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Zeilenvergleich VBA Excel 2003 ?
#1
hallo,

ich habe hier eine Tabelle angehängt.

Könnte mir jemand beim Erstellen eines Zeilenvergleiches behilflich sein?

Zeilen sollen verglichen werden.
1. Zeile mit 2. Zeile
1. Zeile mit 3. Zeile
1. Zeile mit 4. Zeile usw.

dann

2. Zeile mit 3. Zeile
2. Zeile mit 4. Zeile
2. Zeile mit 5. Zeile usw.

usw.
usw.


Ist dies machbar?

LG
Angelina


Angehängte Dateien
.xls   Zeilenvergleich.xls (Größe: 29 KB / Downloads: 16)
Antworten Top
#2
Hallo,

mit diesem Code:

Code:
Private Sub CommandButton1_Click()
Dim rng As Range
Dim loZeile As Long
Dim loSpalte As Long
Application.ScreenUpdating = False
Set rng = Range("DW1")
For loSpalte = 0 To 48
   For loZeile = 1 To 15
       If rng.Offset(loZeile, loSpalte) <> "" Then
           If Application.WorksheetFunction.CountIf(Range(rng.Offset(0, loSpalte), rng.Offset(loZeile - 1, loSpalte)), rng.Offset(loZeile, loSpalte)) > 0 Then rng.Offset(loZeile, loSpalte) = ""
       End If
   Next
Next
Application.ScreenUpdating = True
       
End Sub
Gruß

Edgar

Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Antworten Top
#3
(02.03.2015, 09:55)BoskoBiati schrieb: Hallo,

mit diesem Code:



Code:
Private Sub CommandButton1_Click()
Dim rng As Range
Dim loZeile As Long
Dim loSpalte As Long
Application.ScreenUpdating = False
Set rng = Range("DW1")
For loSpalte = 0 To 48
   For loZeile = 1 To 15
       If rng.Offset(loZeile, loSpalte) <> "" Then
           If Application.WorksheetFunction.CountIf(Range(rng.Offset(0, loSpalte), rng.Offset(loZeile - 1, loSpalte)), rng.Offset(loZeile, loSpalte)) > 0 Then rng.Offset(loZeile, loSpalte) = ""
       End If
   Next
Next
Application.ScreenUpdating = True
       
End Sub
hallo BoskoBiati ,

da kann aber etwas nicht stimmen.
Warum?
Der Ablauf sollte so sein:

1. Zeile nehmen diese mit der 2. Zeile vergleichen dann erhalte ich eine neue Zeile die ich brauche
Weil die neue Zeile aus den Zahlen besteht welche in der 1. + 2. Zeile identisch sind.

1. Zeile nehmen diese mit der 3. Zeile vergleichen dann erhalte ich wieder eine neue Zeile die ich auch brauche
1. bis 10 dann habe ich theoretisch schon 9 neue Zeilen

dann die 2. Zeile nehmen diese mit der 3. Zeile vergleichen dann habe ich wieder eine neue Zeile die ich brauche
usw.

letztendlich denke ich das bei
10 Ursprungszeilen am Ende
10 x 9 /2 = 45 neue Zeilen erstellt sein müssen.


LG
Angelina
Antworten Top
#4
Hallo,

dann mach mal ein Muster, wie das aussehen soll, momentan verstehe ich nämlich nicht, was da das Ergebnis sein soll. Wenn ich vergleiche, dann habe ich entweder einen Einzelwert, den laß ich (nach meinem Verständnis) stehen, oder ich habe einen doppelten Wert, den lösche ich. Ansonsten kann ich bei einem Vergleich nur feststellen "gibt´s" oder "gibt´s nicht"
Gruß

Edgar

Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Antworten Top
#5
(02.03.2015, 10:41)BoskoBiati schrieb: Hallo,

dann mach mal ein Muster, wie das aussehen soll, momentan verstehe ich nämlich nicht, was da das Ergebnis sein soll. Wenn ich vergleiche, dann habe ich entweder einen Einzelwert, den laß ich (nach meinem Verständnis) stehen, oder ich habe einen doppelten Wert, den lösche ich. Ansonsten kann ich bei einem Vergleich nur feststellen "gibt´s" oder "gibt´s nicht"

hallo,

hier ein Muster der Zeile1 vgl. mit Zeile2 = identische Zahlen ergeben die 1. NEUE Zeile die am Ende verbleiben soll.

dito 1. Zeile vgl. mit  Zeile3 usw.

dann 2. Zeile vgl. mit Zeile3 usw.

dann 3. Zeile vgl. mit Zeile 4 usw.
bis
9. Zeile vgl mit Zeile 10

die 10 Ursprungszeilen werden dann alle gelöscht und es verbleiben die 45 NEUE Zeilen

LG
Angelina


Angehängte Dateien
.xls   Zeilenvergleich2.xls (Größe: 35,5 KB / Downloads: 4)
Antworten Top
#6
Hallo,

dann auf ein Neues:

Code:
Option Explicit

Private Sub CommandButton1_Click()
Dim rng As Range
Dim loZeile As Long
Dim loSpalte As Long
Dim loZeile2 As Long
Dim loZiel As Long
loZiel = 11
Application.ScreenUpdating = False
Set rng = Range("DW1")
For loZeile = 0 To 9
   For loZeile2 = loZeile + 1 To 10
       For loSpalte = 0 To 48
           If rng.Offset(loZeile, loSpalte) <> "" Then
               If Application.WorksheetFunction.CountIf(Range(rng.Offset(loZeile2, 0), rng.Offset(loZeile2, 48)), rng.Offset(loZeile, loSpalte)) > 0 Then rng.Offset(loZiel, loSpalte) = rng.Offset(loZeile, loSpalte)
           End If
       Next
       loZiel = loZiel + 1
   Next
Next
Application.ScreenUpdating = True
       
End Sub
Gruß

Edgar

Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Antworten Top
#7
(02.03.2015, 11:29)BoskoBiati schrieb: Hallo,

dann auf ein Neues:


Code:
Option Explicit

Private Sub CommandButton1_Click()
Dim rng As Range
Dim loZeile As Long
Dim loSpalte As Long
Dim loZeile2 As Long
Dim loZiel As Long
loZiel = 11
Application.ScreenUpdating = False
Set rng = Range("DW1")
For loZeile = 0 To 9
   For loZeile2 = loZeile + 1 To 10
       For loSpalte = 0 To 48
           If rng.Offset(loZeile, loSpalte) <> "" Then
               If Application.WorksheetFunction.CountIf(Range(rng.Offset(loZeile2, 0), rng.Offset(loZeile2, 48)), rng.Offset(loZeile, loSpalte)) > 0 Then rng.Offset(loZiel, loSpalte) = rng.Offset(loZeile, loSpalte)
           End If
       Next
       loZiel = loZiel + 1
   Next
Next
Application.ScreenUpdating = True
       
End Sub

hallo nochmals,

schaut schon besser aus - hm... aber warum ist das Ergebnis 53 Zeilen?
10 x 9 / 2 = 45 Zeilen - oder rechne ich falsch?

und

die neuen Zeilen sollen die alten Ursprungszeilen ersetzen und NEU ab DW1 geschrieben werden.

Aber wichtiger ist erstmal die Frage 53/45 Zeilen

LG
Angelina
Antworten Top
#8
hallo,

habe gerade gesehen das es 8 Leerzeilen sind.
Daher 45 + 8 = 53


Also müsste nur noch das gemacht werden:

1. Alle NEUEN Zeilen zusammenrücken ohne Leerzeilen
2. Alte Daten löschen und die NEUEN direkt ab DW1 schreiben
3. Du hast 1to10 - es ist aber unbekannt wieviel Ursprungszeilen es am Anfang sind.
Können mal 10 oder mehr oder weniger sein.

LG
Angelina
Antworten Top
#9
Hallo,

so:
Code:
  Option Explicit

Private Sub CommandButton1_Click()
Dim rng As Range
Dim loZeile As Long
Dim loSpalte As Long
Dim loZeile2 As Long
Dim loZiel As Long
loZiel = 12
Application.ScreenUpdating = False
Set rng = Range("DW1")
For loZeile = 0 To 9
   loZiel = loZiel - 1
  For loZeile2 = loZeile + 1 To 10
      For loSpalte = 0 To 48
          If rng.Offset(loZeile, loSpalte) <> "" Then
              If Application.WorksheetFunction.CountIf(Range(rng.Offset(loZeile2, 0), rng.Offset(loZeile2, 48)), rng.Offset(loZeile, loSpalte)) > 0 Then rng.Offset(loZiel, loSpalte) = rng.Offset(loZeile, loSpalte)
          End If
      Next
      loZiel = loZiel + 1
  Next
Next
Range("DW12:FS56").Cut Range("DW1")
Application.ScreenUpdating = True
     
End Sub
Gruß

Edgar

Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Antworten Top
#10
(02.03.2015, 12:02)BoskoBiati schrieb: Hallo,

so:

Code:
  Option Explicit

Private Sub CommandButton1_Click()
Dim rng As Range
Dim loZeile As Long
Dim loSpalte As Long
Dim loZeile2 As Long
Dim loZiel As Long
loZiel = 12
Application.ScreenUpdating = False
Set rng = Range("DW1")
For loZeile = 0 To 9
   loZiel = loZiel - 1
  For loZeile2 = loZeile + 1 To 10
      For loSpalte = 0 To 48
          If rng.Offset(loZeile, loSpalte) <> "" Then
              If Application.WorksheetFunction.CountIf(Range(rng.Offset(loZeile2, 0), rng.Offset(loZeile2, 48)), rng.Offset(loZeile, loSpalte)) > 0 Then rng.Offset(loZiel, loSpalte) = rng.Offset(loZeile, loSpalte)
          End If
      Next
      loZiel = loZiel + 1
  Next
Next
Range("DW12:FS56").Cut Range("DW1")
Application.ScreenUpdating = True
     
End Sub

hallo,

ja - du hast es bald Smile

Wie gesagt:
1. Alle NEUEN Zeilen zusammenrücken ohne Leerzeilen - ist erledigt


2. Alte Daten löschen und die NEUEN direkt ab DW1 schreiben - ist erledigt

3. Du hast 1to10 - es ist aber unbekannt wieviel Ursprungszeilen es am Anfang sind.
Können mal 10 oder mehr oder weniger sein.

ist noch offen.

Die Letzte Zeile sollte so ermittelt werden.

Was ist die letzte Zeile (mit Wert)  der im Bereich DW:FS steht.

LG
Angelina
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste