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
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.
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)
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
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
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.
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;„“)
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. )
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
.. hab von vb keine ahnung..
)