Zeilenvergleich VBA Excel 2003 ?

[Angelina]

Hallo,

egal ob DW>0 oder FZ>0, das ist beides Quatsch!

hallo

ok - aber die andere Bedingte Formatierung ist notwendig, die kann ich nicht entfernen.

hm..... also mit cut geht es nicht


LG
Angelina

[atilla]

Hallo Edgar,


Nicht ausschneiden, sondern löschen.
Vor dem Löschen den Bereich aber in ein Array einlesen.

Z. B.:

Dim feld
feld = Range("DW" & loLetzte + 2 & ":FS" & loEnd)
Range("DW" & loLetzte + 2 & ":FS" & loEnd).Clearcontents
.... Und hier in den in den Bereich zurükschreiben.

Bin am Handy, deswegen nur so viel.

[BoskoBiati]

Hallo Atilla,

besten Dank, das hat mir gefehlt!

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
Dim loCo As Long
Dim loLetzte As Long
Dim loEnd As Long
Dim arrFeld
For loCo = 65535 To 1 Step -1
If Application.WorksheetFunction.Count(Range("DW" & loCo & ":FS" & loCo)) > 0 Then
   loLetzte = loCo
   Exit For
End If
Next
loZiel = loLetzte + 2
Application.ScreenUpdating = False
Set rng = Range("DW1")
For loZeile = 0 To loLetzte
  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
For loCo = 65535 To 1 Step -1
If Application.WorksheetFunction.Count(Range("DW" & loCo & ":FS" & loCo)) > 0 Then
   loEnd = loCo
   Exit For
End If
Next
loCo = loEnd - loLetzte - 1
arrFeld = Range("DW" & loLetzte + 2 & ":FS" & loEnd)
Range("DW" & loLetzte & ":FS" & loEnd).ClearContents
Range("DW1:FS" & loCo) = arrFeld

Application.ScreenUpdating = True
   
End Sub

[Angelina]

Hallo Atilla,
hallo BoskoBiati


vielen lieben dank für euren Einsatz/Mühe und Zeit.

Bin noch am testen - mir ist aufgefallen, das wenn ich nicht 10 Zeilen sondern 20 Zeilen als
Ausgangssituation habe das dann trotzdem nur so 45 Zeilen nach dem Zeilenvergleich rauskommen.  

Einfach mal meine Daten kopieren und dann unten anhängen - dann sind es 20 Ausganszeilen.

Ergebnis immer 45 Zeilen.

Sorry, wenn das wieder so eine verzwickte Sache ist.

LG
Angelina

[BoskoBiati]

Hallo,


ja, in einer Zeile vergessen, die 10 zu ersetzen:

For loZeile2 = loZeile + 1 To loLetzte

[Angelina]

hallo,

ok - D AN K E

ist dann erledigt

Nochmals danke für euren Einsatz


LG
Angelina

[Angelina]

Hallo Atilla,

besten Dank, das hat mir gefehlt!

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
Dim loCo As Long
Dim loLetzte As Long
Dim loEnd As Long
Dim arrFeld
For loCo = 65535 To 1 Step -1
If Application.WorksheetFunction.Count(Range("DW" & loCo & ":FS" & loCo)) > 0 Then
   loLetzte = loCo
   Exit For
End If
Next
loZiel = loLetzte + 2
Application.ScreenUpdating = False
Set rng = Range("DW1")
For loZeile = 0 To loLetzte
  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
For loCo = 65535 To 1 Step -1
If Application.WorksheetFunction.Count(Range("DW" & loCo & ":FS" & loCo)) > 0 Then
   loEnd = loCo
   Exit For
End If
Next
loCo = loEnd - loLetzte - 1
arrFeld = Range("DW" & loLetzte + 2 & ":FS" & loEnd)
Range("DW" & loLetzte & ":FS" & loEnd).ClearContents
Range("DW1:FS" & loCo) = arrFeld

Application.ScreenUpdating = True
   
End Sub

hallo BoskoBiati,

ich muss dieses Thema nochmals vorholen.

Diese Version ist/war ja die Endversion (zusätzlich der Änderung auf: For loZeile2 = loZeile + 1 To loLetzte )

Diese Sub vergleicht ja von oben nach unten jede Zeile mit der anderen Zeile.
Ist auch perfekt so - danke nochmals für die große Hilfe.

Nun ist es so, das ich eine kleine Alternative davon brauche.

Diese Alternativ-Version soll nicht jede Zeile mit der anderen Zeile vergleichen, sondern wie folgt:

Beispiel:
Es gibt 10 Zeilen (oder mehr oder weniger - aber wir nehmen mal 10 Zeilen)

Die 1. Zeile wird mit der 2. Zeile verglichen
Die 2. Zeile wird mit der 3. Zeile verglichen
Die 3. Zeile wird mit der 4. Zeile verglichen
Die 4. Zeile wird mit der 5. Zeile verglichen
Die 5. Zeile wird mit der 6. Zeile verglichen
Die 6. Zeile wird mit der 7. Zeile verglichen
Die 7. Zeile wird mit der 8. Zeile verglichen
Die 8. Zeile wird mit der 9. Zeile verglichen
Die 9. Zeile wird mit der 10. Zeile verglichen
ENDE


Würdest du mir diese Version bitte noch erstellen?

Ich danke dir vorab für jede Zeit und Mühe

LG
Angelina

[Angelina]

hallo @,

könnte mir bitte jemand helfen zu meinem Beitrag letzten Beitrag / Alternativ-Version
[b]Geschrieben von Angelina - Gestern, 10:30[/b]


ich gehe mal davon aus, das BoskoBiati keine Zeit hat.

Bitte ...


LG
Angelina

[BoskoBiati]

Hallo,

keine Zeit ist das geringere Problem, eher keine Lust, ständig neue Anforderungen zu bedienen, die man selbst lösen könnte, wenn man sich nur mit der Materie befassen würde!!! Ich mag es nicht besonders, wenn sich jemand eine fertige Lösung schreiben läßt, die einbaut und sich dann nicht mehr damit auseinandersetzt. Dafür ist das Forum eigentlich nicht da!

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
Dim loCo As Long
Dim loLetzte As Long
Dim loEnd As Long
Dim arrFeld
For loCo = 65535 To 1 Step -1
If Application.WorksheetFunction.Count(Range("DW" & loCo & ":FS" & loCo)) > 0 Then
   loLetzte = loCo
   Exit For
End If
Next
loZiel = loLetzte + 2
Application.ScreenUpdating = False
Set rng = Range("DW1")
For loZeile = 0 To loLetzte-1
     For loSpalte = 0 To 48
         If rng.Offset(loZeile, loSpalte) <> "" Then
             If Application.WorksheetFunction.CountIf(Range(rng.Offset(loZeile+1, 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
For loCo = 65535 To 1 Step -1
If Application.WorksheetFunction.Count(Range("DW" & loCo & ":FS" & loCo)) > 0 Then
   loEnd = loCo
   Exit For
End If
Next
loCo = loEnd - loLetzte - 1
arrFeld = Range("DW" & loLetzte + 2 & ":FS" & loEnd)
Range("DW" & loLetzte & ":FS" & loEnd).ClearContents
Range("DW1:FS" & loCo) = arrFeld

Application.ScreenUpdating = True
   
End Sub

ungetestet!

[Angelina]

Hallo,

Ich mag es nicht besonders, wenn sich jemand eine fertige Lösung schreiben läßt, die einbaut und sich dann nicht mehr damit auseinandersetzt.

Bitte entschuldige - ich versuche wirklich mich damit zu beschäftigen - ist nur sehr schwer - stellenweise.

Danke nochmals für deine Hilfe - wirklich DANKE

habe getestet - bekomme hier die Fehlermeldung

Code:

For loZeile = 0 To loLetzte-1
     For loSpalte = 0 To 48
         If rng.Offset(loZeile, loSpalte) <> "" Then
             If Application.WorksheetFunction.CountIf(Range(rng.Offset(loZeile+1, 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

Next ohne For


Bitte entschuldige

LG
Angelina