Hallo wer-weiss-was-Gemeinde,
ich habe schon viele Lösungen hier per Recherche gefunden. Jetzt habe ich eine Problemstellung, dessen Lösung ich nicht gefunden habe.
Excel 2003: Ich importiere eine Datei und habe dann mehrere Spalten und Zeilen die so aussehen:
A B C D
1 abc
2 qwer 1 1234 1234
3 tzrt 1 567 345
4 obc
5 zuta 1 789 456
6 ghjk 1 6789 7654
7 sdfg 1 267 23
Für die weitere Verarbeitung soll in dieser Tabelle folgendes passieren:
Excel soll die Anzahl der Zeilen zählen zwischen den Blöcken unterhalb der Zelle mit drei Zeichen. Dann Leerzeilen einfügen, so dass unter jedem Block (Zelle mit drei Buchstaben) 7 Zeilen stehen. Es gibt immer 4 Blöcke. Folgende Schwierigkeit besteht noch, beim Datenimport wird es jedesmal unterschiedliche Zeilenanzahl pro Block geben (von 0 bis 7 Zeilen). Ich hoffe, ich konnte mein Problem verständlich schildern und es gibt eine Lösung.
mfG
Excel soll die Anzahl der Zeilen zählen zwischen den Blöcken
unterhalb der Zelle mit drei Zeichen. Dann Leerzeilen
einfügen, so dass unter jedem Block (Zelle mit drei
Buchstaben) 7 Zeilen stehen. Es gibt immer 4 Blöcke. Folgende
Schwierigkeit besteht noch, beim Datenimport wird es jedesmal
unterschiedliche Zeilenanzahl pro Block geben (von 0 bis 7
Zeilen). Ich hoffe, ich konnte mein Problem verständlich
Hi Stefan,
Code erwartet die daten in Tabelle1 und schreibt sie neu formatiert nach tabelle2, ggfs namen anpassen und Startzeilen der tabellen falls es Überschriften gibt.
Alt+F11, Einfügen–Moduk, Code reinkopieren, ggfs. anpassen, Editor schließen. makro ausführen über Alt-F11.
Option Explicit
'
Sub Liste()
Dim ZeiQ As Long, StartQ As Long, ZeiZ As Long, StartZ As Long, Von(1 To 5), Anz
Dim wksZ As Worksheet
Set wksZ = Worksheets("Tabelle2")
On Error GoTo Ende:
wksZ.Range("A:smiley:").ClearContents
StartQ = 1 'Startzeile Quelle, auf 2 setzen falls es Überschrift gibt
StartZ = 1 'Startzeile Ziel, auf 2 setzen falls es Überschrift gibt
ZeiZ = StartZ
With Worksheets("Tabelle1")
For ZeiQ = StartQ To .Range("A" & Rows.Count).End(xlUp).Row
If Len(Cells(ZeiQ, 1)) = 3 Then
Anz = Anz + 1
Von(Anz) = ZeiQ
End If
Next ZeiQ
Von(5) = ZeiQ
For Anz = 1 To 4
.Range(Cells(Von(Anz), 1), Cells(Von(Anz + 1) - 1, 4)).Copy \_
Destination:=wksZ.Cells(StartZ + (Anz - 1) \* 8, 1)
Next Anz
End With
Ende:
If Err.Number 0 Then MsgBox "Fehler"
End Sub
Gruß
Reinhard
Hallo Reinhard,
vielen Dank für deine schnelle Antwort.
Ich habe das Makro angelegt. Den ersten Block legt er auch an. Dann nutzt das Makro deine Msgbox mit der Meldung ‚Fehler‘.
Ich muss allerdings sagen, dass ich deinen Vorschlag zu Hause ausprobiert habe. Dort läuft bei mir Excel 2007, kann es daran liegen, oder was mache ich falsch?
Tabellenblätter heißen auch Tabelle1 und Tabelle2
Der erste Block mit den Zeilen aus Tabelle1 wird angelegt und dann kommt die Box mit Fehler.
Kannst du mir noch einmal helfen?
Danke im voraus und einen schönes Wochenende wünscht
Stefan
Hallo Reinhard,
jetzt klappt es. Man sollte sich auch an seine Vorgaben, die man als Frage stellt auch halten. Ich hatte nur 2 Blöcke eingegeben.
Jetzt ist alles prima.
Gut wenn man Experten fragen kann.
Noch einmal Danke für die prompte Beantwortung.
Tschüss aus Hamburg
Stefan
1 „Gefällt mir“