Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1072to1076
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
Inhaltsverzeichnis

Spalten vergleichen und Zeilen verschieben

Spalten vergleichen und Zeilen verschieben
07.05.2009 09:58:30
Silke
Hallo,
ich habe da ein kleines Problem: ich möchte gerne Duplikate in den Spalten A und B suchen und die betreffenden Zeilen dann in die Tabelle 2 verschieben
Kann mir da jemand helfen?
Silke

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spalten vergleichen und Zeilen verschieben
07.05.2009 10:37:59
David
Hallo Silke,
auf die schnelle:
Option Explicit

Sub dup()
Dim i
With Worksheets("Tabelle1")
For i = .Range("A65000").End(xlUp).Row To 1 Step -1
If Cells(i, 1) = Cells(i, 2) Then
Rows(i & ":" & i).Copy Destination:=Worksheets("Tabelle2").Range(i & ":" & i)
Rows(i + 1 & ":" & i + 1).Delete Shift:=xlUp
End If
Next
End With
Worksheets("Tabelle2").UsedRange.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
End Sub


Die Zeile 1 in Tabelle2 muss vorher (!) eine Überschrift haben, sonst produziert die Leerzeilen-Löschung einen Fehler! Könnte man noch anders lösen, aber da ich deine Anforderungen nicht kenne...
Rückmeldung wäre nett.
gruß
David

Anzeige
AW: Spalten vergleichen und Zeilen verschieben
07.05.2009 11:05:26
Silke
Hallo,
vielen Dank für die schnelle ANtwort, dein Progarmm funktioniert zwar, aber ich möchte noch das er z.B. A3 mit der gesamt spalte B vergleicht, wie muss ich das ensprechend ändern das Programm
Silke
AW: Spalten vergleichen und Zeilen verschieben
07.05.2009 11:09:59
David
Silke,
dies ist eine ganz andere Aussage, als in deinem ersten Posting. Der von mir gemachte Lösungsvorschlag lässt sich darauf nicht ohne weiteres anwenden.
Bevor ich hier noch mehr Zeit nutzlos investiere, erläutere bitte mal genau, wie deine Daten aussehen und was du erreichen möchtest. Am besten noch mit einer Beispieltabelle.
Gruß
David
AW: Spalten vergleichen und Zeilen verschieben
07.05.2009 12:10:57
Silke
Sorry David für die ungenauen Details,
ich habe eine Datei mit 20000 Zeilen, nun habe ich bereits einige Sachen bereinigt und A von B getrennt, in Spalte A steht die Serie und in Spalte B die Unterserei. Durch die fortlaufende Erweiterung sind aber auch Unterserien in A gekommen. Da es durchaus nun sein kann, das sich doppelt und dreifach eingeschlichen hat, möchte ich die doppelten halt in eine neue Tabelle schreiben . Ich hoffe damit kann man etwas anfangen. Da ich momentan keine Daei hochlade kann habe ich unen eine geschroeben, die / sollen die Spalten ergeben
Serie / Unterserie / Stk Preis
A / B123 /
A / B124 /
B124 /
Silke
Anzeige
AW: Spalten vergleichen und Zeilen verschieben
07.05.2009 12:38:46
David
würde es da nicht ausreichen, wenn man in den entsprechenden Zeilen die Werte eins nach rechts verschiebt und dann einen Filter auf die Tabelle legt? Ggf. kann man die dadurch entstehenden Leerzellen mit den darüber stehenden Serien-Wert füllen.
Steht in der Tabelle in Spalte 3 nun auch was (Überschrift ja/Werte nein?!)?
Gruß
David
AW: Spalten vergleichen und Zeilen verschieben
07.05.2009 12:44:42
Silke
Da bringst du mich auf eine Idee, sicher kann man dann das was in Spalte A steht in spalte B schieben, aber ich weiß nicht ob das dann zu unübersichtlich wird. Müsste dann immer noch mal mit einem Spezialfilter rüber, aber schaden kanns ja nicht. Außerdem müsste man dann schauen ob in Zelle B schon etwas steht, das natürlich nicht überschrieben werden darf. In der Spalte c bis k steht natürlich auch noch was und darf nicht gelöscht werden, da ich damit berechnung ausführe
Anzeige
AW: Spalten vergleichen und Zeilen verschieben
07.05.2009 12:48:38
David
Was ist mit dem Vorschlag von Tino? Ich hab mir das nicht angeschaut, aber löst das vielleicht dein(e) Problem(e)?
Gruß
AW: Spalten vergleichen und Zeilen verschieben
07.05.2009 13:21:59
Silke
Nein bisher nicht richtig, sind ein paar Fehler noch drin.
Du wolltest doch nur die doppelten? oT.
07.05.2009 23:43:01
Tino
AW: Spalten vergleichen und Zeilen verschieben
07.05.2009 11:29:02
Tino
Hallo,
habe hier mal was zusammengebastelt.
Es werden die Daten gesucht die in A mehrfach oder in B mehrfach vorkommen.
Tabellennamen für Quelle und Ziel musst Du im Code anpassen.
Es wird eine Hilfsspalte am Ende der Quelle verwendet, diese wird am Schluss wieder gelöscht.
Ich gehe im Code auch davon aus, dass sich in der Zeile 1 eine Überschrift befindet.
Option Explicit

Sub Doppelte_Nach_Tab2()
Dim Bereich As Range
Dim shQuelle As Worksheet, shZiel As Worksheet
Dim iCalc As Integer
Dim LRow As Long


Set shQuelle = Sheets("Tabelle1")   'Tabellennamen Quelle anpassen 
Set shZiel = Sheets("Tabelle2")     'Tabellennamen Ziel anpassen 
        
        
With Application
 iCalc = .Calculation
 .ScreenUpdating = False
 .EnableEvents = False
 .Calculation = xlCalculationManual
        
        On Error Resume Next 'letze Zeile in Spalte A u. B Suchen 
            LRow = shQuelle.Range("A:B").Find("*", , xlValues, 2, 1, 2, False, False).Row
            LRow = .Max(LRow, shQuelle.Range("A:B").Find("*", , xlFormulas, 2, 1, 2).Row)
        On Error GoTo 0
        
   If LRow > 1 Then 'Prüfen ob der Bereich nicht in der Überschrift liegt 
        
        Set Bereich = shQuelle.Range("A2:A" & LRow)
        Set Bereich = Bereich.Offset(0, shQuelle.Columns.Count - Bereich.Column)
            'Ziel leer machen 
            shZiel.Range("A2", shZiel.Cells(shZiel.Rows.Count, shZiel.Columns.Count)).Value = ""
            'Hilfsformel schreiben 
            Bereich.FormulaR1C1 = _
                    "=IF(OR(COUNTIF(R2C1:RC1,RC1)>1,COUNTIF(R2C2:RC2,RC2)>1),0,"""")"
            'prüfen ob 0 als Ergebnis vorhanden 
            If .WorksheetFunction.CountIf(Bereich, 0) > 0 Then
             'Zeilen mit Ergebnis 0 kopieren 
             Bereich.SpecialCells(xlCellTypeFormulas, 1).EntireRow.Copy shZiel.Range("A2")
            End If
            
            'Hilfsspalte löschen 
            shQuelle.Columns(shQuelle.Columns.Count).Delete
   End If
   
 .Calculation = iCalc
 .ScreenUpdating = True
 .EnableEvents = True
End With
End Sub


Gruß Tino

Anzeige
AW: Spalten vergleichen und Zeilen verschieben
07.05.2009 12:40:07
Tino
Hallo,
bei soviel Daten ist es angebracht den Bereich zu Sortieren, damit Excel schneller arbeiten kann.
Es wird erst nach den doppelten Sortiert und danach wieder zurück.
Ich hoffe, dass ich dich richtig verstanden habe ;-)
Sub Doppelte_Nach_Tab2()
Dim Bereich As Range, SortBereich As Range
Dim shQuelle As Worksheet, shZiel As Worksheet
Dim iCalc As Integer
Dim LRow As Long


Set shQuelle = Sheets("Tabelle1")   'Tabellennamen Quelle anpassen 
Set shZiel = Sheets("Tabelle2")     'Tabellennamen Ziel anpassen 
        
        
With Application
 iCalc = .Calculation
 .ScreenUpdating = False
 .EnableEvents = False
 .Calculation = xlCalculationManual
        
        On Error Resume Next 'letze Zeile in Spalte A u. B Suchen 
            LRow = shQuelle.Range("A:B").Find("*", , xlValues, 2, 1, 2, False, False).Row
            LRow = .Max(LRow, shQuelle.Range("A:B").Find("*", , xlFormulas, 2, 1, 2).Row)
        On Error GoTo 0
        
   If LRow > 1 Then 'Prüfen ob der Bereich nicht in der Überschrift liegt 
        
        Set Bereich = shQuelle.Range("A2:A" & LRow)
        Set Bereich = Bereich.Offset(0, shQuelle.Columns.Count - Bereich.Column)
        Set SortBereich = Bereich.Offset(0, -1)
            'Hilsspalte zum Sortieren 
            SortBereich.FormulaR1C1 = "=ROW()"
            
            'Ziel leer machen 
            shZiel.Range("A2", shZiel.Cells(shZiel.Rows.Count, shZiel.Columns.Count)).Value = ""
            'Hilfsformel schreiben 
            Bereich.FormulaR1C1 = _
                    "=IF(OR(COUNTIF(R2C1:RC1,RC1)>1,COUNTIF(R2C2:RC2,RC2)>1),0,"""")"
            'prüfen ob 0 als Ergebnis vorhanden 
            If .WorksheetFunction.CountIf(Bereich, 0) > 0 Then
             'sortieren nach 0 
             shQuelle.UsedRange.Sort Bereich(1, 1), xlAscending, , , , , , xlYes
             'Zeilen mit Ergebnis 0 kopieren 
             Bereich.SpecialCells(xlCellTypeFormulas, 1).EntireRow.Copy shZiel.Range("A2")
             Bereich.SpecialCells(xlCellTypeFormulas, 1).EntireRow.Delete
             'zurücksortieren 
             shQuelle.UsedRange.Sort SortBereich(1, 1), xlAscending, , , , , , xlYes
            End If
            
            'Hilfsspalte löschen 
            shQuelle.Columns(shQuelle.Columns.Count).Delete
            shQuelle.Columns(shQuelle.Columns.Count - 1).Delete
   End If
   
 .Calculation = iCalc
 .ScreenUpdating = True
 .EnableEvents = True
End With
End Sub


Gruß Tino

Anzeige
AW: Spalten vergleichen und Zeilen verschieben
07.05.2009 12:51:32
Silke
Hallo Tino,
leider funktioniert es nicht so wie ich mir das vortselle, so werden ein paar garnicht kopiert, obwohl sie nicht doppelt sind. Das sind diejenigen die die eine Sortierte Liste anführen, also das erste A wird nicht kopiert obwohl es nicht doppelt ist
Ich danke dir trotzdem für deine Mühe
Silke
AW: Spalten vergleichen und Zeilen verschieben
08.05.2009 09:28:45
Tino
Hallo,
oben hast Du geschrieben.
"...ich möchte gerne Duplikate in den Spalten A und B suchen und die betreffenden Zeilen dann in die Tabelle 2 verschieben..."
und jetzt schreibst Du
"...so werden ein paar garnicht kopiert, obwohl sie nicht doppelt sind..."
Was willst Du jetzt, die doppelten oder die nicht doppelten?
Dieser Code kopiert jetzt alle die mehr als einmal in Spalte A bzw. in Spalte B vorkommen.
Sub Doppelte_Nach_Tab2()
Dim Bereich As Range, SortBereich As Range
Dim shQuelle As Worksheet, shZiel As Worksheet
Dim iCalc As Integer
Dim LRow As Long


Set shQuelle = Sheets("Tabelle1")   'Tabellennamen Quelle anpassen 
Set shZiel = Sheets("Tabelle2")     'Tabellennamen Ziel anpassen 
        
        
With Application
 iCalc = .Calculation
 .ScreenUpdating = False
 .EnableEvents = False
 .Calculation = xlCalculationManual
        
        On Error Resume Next 'letze Zeile in Spalte A u. B Suchen 
            LRow = shQuelle.Range("A:B").Find("*", , xlValues, 2, 1, 2, False, False).Row
            LRow = .Max(LRow, shQuelle.Range("A:B").Find("*", , xlFormulas, 2, 1, 2).Row)
        On Error GoTo 0
        
   If LRow > 1 Then 'Prüfen ob der Bereich nicht in der Überschrift liegt 
        
        Set Bereich = shQuelle.Range("A2:A" & LRow)
        Set Bereich = Bereich.Offset(0, shQuelle.Columns.Count - Bereich.Column)
        Set SortBereich = Bereich.Offset(0, -1)
            'Hilsspalte zum Sortieren 
            SortBereich.FormulaR1C1 = "=ROW()"
            Set SortBereich = shQuelle.Range("A1", Cells(LRow, shQuelle.Columns.Count))
            
            'Ziel leer machen 
            shZiel.Range("A2", shZiel.Cells(shZiel.Rows.Count, shZiel.Columns.Count)).Value = ""
            'Hilfsformel schreiben 
            Bereich.FormulaR1C1 = _
                    "=IF(OR(COUNTIF(R2C1:R" & LRow & "C1,RC1)>1,COUNTIF(R2C2:R" & LRow & "C2,RC2)>1),0,"""")"
            'prüfen ob 0 als Ergebnis vorhanden 
            If .WorksheetFunction.CountIf(Bereich, 0) > 0 Then
             'sortieren nach 0 
             SortBereich.Sort Bereich(1, 1), xlAscending, , , , , , xlYes
             'Zeilen mit Ergebnis 0 kopieren 
             Bereich.SpecialCells(xlCellTypeFormulas, 1).EntireRow.Copy shZiel.Range("A2")
             Bereich.SpecialCells(xlCellTypeFormulas, 1).EntireRow.Delete
             'zurücksortieren 
             SortBereich.Sort SortBereich(2, SortBereich.Columns.Count - 1), xlAscending, , , , , , xlYes
            End If
            
            'Hilfsspalte löschen 
            shQuelle.Columns(shQuelle.Columns.Count).Delete
            shQuelle.Columns(shQuelle.Columns.Count - 1).Delete
   End If
   
 .Calculation = iCalc
 .ScreenUpdating = True
 .EnableEvents = True
End With
End Sub


Gruß Tino

Anzeige

338 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige