Excel Makro Daten/Zellen vergleichen, verschieben, löschen

[kiki2006]

Hallo liebe Helfer,

ich hoffe Ihr könnt mir helfen. Ich habe einige Excel Tabellen die Ausgewertet werden sollen, dafür müssen sie aber umgestellt werden. Hab leider keine ahnung von VBA…
Im Grunde müssen die Daten Verglichen werden verschoben und Gelöscht.
Da ich schlecht erklären kann schematisch:

1 A B C D E F G H I J K L …
2 3 xy 3.3.01 r 2 3 4 5 6 7
3 3 xy 4.3.01 r 3 4 5 6 7 8
4 3 xy 5.3.01 r 1 2 3 4 5 6
5 3 xy 6.3.01 r 2 7 6 5 4 3
6 3 xy 7.3.01 r 3 3 5 6 7 8
7 7 za 3.6.02 l 1 2 3 4 5 6
8 7 za 4.6.02 l 2 2 3 8 7 0
9 4 bg 1.2.01 r …
10 4 bg 2.2.01 r …
11 4 bg 3.2.01 r …
12 …

jetzt hätt ich gern C3 in K2 verschoben,
D ist unwichtig, E3:J3 in L2:Q2 verschoben, dann kann Zeile 3 gelöscht werden
und wenn in zeile 4 (A2=A4) dann soll C4 in R2 verschoben,
D ist unwichtig, und E4:J4 in S2:X2 verschoben werden, dann kann die zeile 4 gelöscht werden.
das dann immer so weiter bis der nächste kunde A7 und wieder das selbe

vielen dank im vorraus…

[Riedl_Manfred]

Hallo,

Zeiche deine Daten bewegungenm, wie sie haben willst, mit den Makro Recorder auf.

Gruß Fred

[kiki2006]

Hallo Fred,

danke für die schnelle antwort.
wie zeichne ich meine Datenbewegungsgemäß mit dem Makro Recorder auf?
für dummis bitte … hab von vb keine ahnung…

Gruß Kati

[kiki2006]

Hallo Fred,

ich habs verstanden , leider füllt ein kunde mal eine zeile und ein anderer 5 zeilen, und mit 500 zeilen kundendaten dauert das „strgx“ „strgv“ einfach zu lange… das möchte ich ja umgehen. Ich möchte eigentlich ein kleines programm das ich dann auf jeder dieser excel tabellen anwenden kann.

Gruß
Kati

[xaver_escort]

Hallo
sorry kann nicht helfen, ich verstehe nicht was du machen willst

[Riedl_Manfred]

den code fügst in der Tabelle ein , (in Code Editor von Excel), wo die daten geordnet werden sollen.

Der Code ist so gemacht beim Klick auf die Quell Zelle, wird die Quell Zelle kopiert.
Beim klick auf die Ziel Zelle wo die Daten hingehören, dort werden die Ausgeschieten Daten eingefügt.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Range(„A1000“)

[Carsten5]

Ich kann leider auch nicht helfen. Ich verstehe auch nicht was du genau machen moechtest.
Carsten

[Rudi_O]

Hallo kiki

Wenn ich richtig verstanden habe, dann möchtest du, wenn der Wert in Spalte A identisch ist, alle Werte im Bereich C + E:J in einer Zeile hintereinander haben.
Ich habe dazu ein Makro gebastelt:

Sub umstellen()

Range(„A1“).Select
zae = 0
Do While ActiveCell.Offset(1, 0).Range(„A1“).Value „“
pos = ActiveCell.Address
k = ActiveCell.Value

If ActiveCell.Offset(1, 0).Range(„A1“).Value = k Then

ActiveCell.Offset(0, zae * 7 + 10).Range(„A1“).Value = Selection.Offset(1, 2).Range(„A1“).Value
For i = 1 To 6
ActiveCell.Offset(0, zae * 7 + 10 + i).Range(„A1“).Value = Selection.Offset(1, 3 + i).Range(„A1“).Value
Next i
ActiveCell.Offset(1, 0).Rows(„1:1“).EntireRow.Select
Selection.Delete Shift:=xlUp
Range(pos).Select
zae = zae + 1
Else
Selection.Offset(1, 0).Range(„A1“).Select
zae = 0
End If
Loop

End Sub

Ich bin dabei exakt von deinem Beispiel ausgegangen. Wenn die echten Bereiche anders sind, dann einfach anpassen. Das Makro geht davon aus, dass der erste Wert in Zelle A1 steht: Range(„A1“).Select

ich hoffe, damit kommst du klar, ansonsten wieder fragen

[kiki2006]

Hallo Rudi,

Super… Vielen Vielen Dank es hat geklappt!!!
Echt klasse, riesen Arbeitserleichterung )

Gruß
Kati

[Brandis]

tut mir leid, kann nicht helfen
Gruß
Brandis

[kiki2006]

Hallo Rudi,

ich versuche gerade den Makro zu verstehen, bsp.: wenn ich jetzt datenblöcke habe die nicht nur bis J gehen und ab K wird die nächste zeile eingesetzt, sondern bis Q und ab R soll die nächste zeile eingesetzt werden. was muss ich wo ändern… und danke danke danke für die hilfe

Gruß Kati

[Rudi_O]

Hallo kiki,
die Änderungen musst du hier vornehmen:

For i = 1 To 6

die 6 ist die Anzahl der Spalten, des Blocks E:J . Wenn dein Block breiter ist, einfach diese Zahl entsprechend erhöhen.

und hier:

ActiveCell.Offset(0, zae * 7 + 10) …

die 7 gibt an, wie viele Spalten der nächste Datenblock nach rechts versetzt wird. Ergibt sich aus Spalte C + Spalten E:J

Ich hoffe, das ist verständlich erklärt.

[symphony60]

Wenn es um reines Verschieben oder Löschen von bestimmten Zellen geht, dann würde ich vorschlagen, einfach eine Makroaufnahme zu starten, diese Aktionen durchzuführen und die Makroaufnahme zu beenden. Mit der Tastenkombination ALT-F11 kommt man in den VBA-Editor und kann sich das erzeugte Programm anschauen. Man begreift dann, schnell, wie der Hase läuft.

Wenn aber Bedingungen existieren, welche Zelle wohin verschoben werden soll, welche Zeile oder Spalte gelöscht werden soll, müsste man diese Bedingungen definieren. Aus dem mit der Anfrage übersandten Tabellenschema kann ich keine solchen Bedingungen entnehmen. Ich kann auch nicht entnehmen, wo ein „nächster Kunde“ beginnt. Auch da müsste man die Regel klar definieren.

Zu einer weiteren Hilfe wären diese ergänzenden Angaben erforderlich.

[Sebra7]

Hallo
Sorry, voll nicht begriffen, was Du möchtest.

Verschieben von C3 in K2:
Ausschneiden und Einfügen.
Analoges bei E3:J3 sowie E4und J4

Es gäbe auch noch etwas anderes.
Nehme deine Matrix auf ein anderes Tabellenblatt und füge in den jeweiligen Zellen die Formeln ein. Beispiel: Auf dem Tabellenblatt in der Spalte K2 die Formel: =Matrix!C3 somit kannst Du das Blatt später ausblenden und die matrix ist nicht mehr sichtbar.
Für Zeile 4 kannst Du dann im Tabellenblatt in die zelle R2 folgende Formel schreiben:
=WENN((Matrix!A2=Matrix!A4);Matrix!C4;"")

Grüsse Sebastian

[kiki2006]

Hallo Rudi,

vielen Dank nochmal, und es ist gut verständlich … (für dummis).
Es funktioniert einwandfrei, einfach toll vielen vielen Dank. Du hat mir beistimmt ne woche Arbeit erspart. )

Vielen Dank und Gruß
Kiki

[Franz_e6478d]

Hallo Kiki,

nach folgend ein Makro zur Umgruppierung der Daten.

Gruß
Franz

Sub Daten\_umgruppieren()
 'verschiebt Daten zu identischen Schlüsseln (z.B. Kunden-Nr) aus
 'mehreren Zeilen in die 1. Zeile zum Schlüssel und löscht die überzähligen Zeilen
 'Voraussetzung: Die Tabelle muss nach dem Schlüssel sortiert sein

 Dim wks As Worksheet 'Objekt-Variable für das Tabellenblatt in dem umgruppiert wird
 Dim varKey As Variant 'Merker für den Schlüssel der gerade abgearbeitet wird.
 Dim lngZeile As Long 'laufender Zeilen-Zähler
 Dim lngZeileKey As Long 'Merker für jeweils 1. Zeile mit der SchlüsselNr
 Dim lngZeileL As Long 'Merker für letzte Zeile der Liste
 Dim lngSpalte As Long
 Dim lngSpalteMax As Long 'Merker für letzte Spalte in die Daten verschoben wurden
 Dim StatusCalc As Long 'Merker für Berechnungsmodus zu Beginn der Makroausführung
 Dim bolLoeschen As Boolean 'Merker, ob Zeilen gelöscht wurden

 On Error GoTo Fehler

 Set wks = ActiveSheet

 'Makrobremsen lösen
 With Application
 .ScreenUpdating = False
 StatusCalc = .Calculation
 .Calculation = xlCalculationManual
 .EnableEvents = False
 End With

 With wks
 lngZeileL = .Cells(.Rows.Count, 1).End(xlUp).Row
 For lngZeile = 2 To lngZeileL
 If varKey .Cells(lngZeile, 1).Value Then
 'neu Schlüssel-Nummer merken für Vergleich
 varKey = .Cells(lngZeile, 1).Value
 'Zeile merken für Verschieben der Zellen aus den Folgezeilen
 lngZeileKey = lngZeile
 'Startspalte für das Verschieben der Zellen aus den Folgezeillen setzen
 lngSpalte = 11 'Spalte K - ab hier werden die Daten aus den anderen Zeilen eingefügt
 Else
 'Zelle Cx verschieben
 .Cells(lngZeile, 3).Cut Destination:=.Cells(lngZeileKey, lngSpalte)
 lngSpalte = lngSpalte + 1 'nächste Einfüge Spalte setzen
 'Zellen Ex:Jx verschieben
 .Range(.Cells(lngZeile, 5), .Cells(lngZeile, 10)).Cut \_
 Destination:=.Cells(lngZeileKey, lngSpalte)
 lngSpalte = lngSpalte + 6 'nächste Einfüge Spalte setzen
 If lngSpalte \> lngSpalteMax Then lngSpalteMax = lngSpalte - 1
 .Rows(lngZeile).ClearContents
 bolLoeschen = True
 End If
 Next lngZeile

 'Spaltentitel kopieren nach Spalte K bis zur letzten Spalte
 For lngSpalte = 11 To lngSpalteMax Step 7
 'Spaltentitel C1 koieren
 .Cells(1, 3).Copy Destination:=.Cells(1, lngSpalte)
 'Spaltentitel E1:J1 kopieren
 .Range(.Cells(1, 5), .Cells(1, 10)).Copy Destination:=.Cells(1, lngSpalte + 1)
 Next lngSpalte

 'Zeilen löschen, in denen die Inhalte gelöscht wurden
 If bolLoeschen = True Then
 With .Range(.Cells(2, 1), .Cells(lngZeileL, 1))
 .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 End With
 End If

 'Spaltenbreiten auf optimale Breite formatieren
 If lngSpalteMax \> 0 Then
 .Range(.Columns(11), .Columns(lngSpalteMax)).AutoFit
 End If

 End With
Fehler:
 With Err
 Select Case .Number
 Case 0 'Alles OK
 Case Else
 MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, \_
 vbInformation + vbOKOnly, "Fehler im Makro: Daten\_umgruppieren"
 End Select
 End With
 'Makrobremsen zurücksetzen
 With Application
 .ScreenUpdating = True
 StatusCalc = .Calculation
 .Calculation = StatusCalc
 .EnableEvents = True
 End With
End Sub

[kiki2006]

Hallo Franz,

vielen Dank für deine Mühe, jedoch hat mir Rudi schon super geholfen und es funktioniert einwandfrei.

Vielen Vielen Dank trotzdem

Gruß
Kiki

[Anonym_5b813eba76fe]

Hallo,
sorry - das ist ja total komplex.
Tut mir leid - da kann ich leider nicht helfen.
Gruß,
Ptonka