Konvertieren Daten und Spaltennamen nach Zeilen transportieren

28/10/2008 - 12:24 von Willy Steffen | Report spam
Hallo guten Tag
Ich habe eine alte Adressendatei im TXT oder HTML Format vorhanden. Ich habe
nun mit Excell die Daten wiefolgt ordnen können:
Spalte1 sind alle Spaltennamen und in der 2ten alle Daten, sieht skizzenhaft
in etwa so aus:
Spalte 1... Spalte2
<BR> leer
Name1...Daten1
Name2...Daten2
uswusw
Name10..Daten10
<BR> leer
<BR> leer
Name1...Daten1
Name2...Daten2
uswusw
Name34..Daten34
<BR> leer
<BR> leer

etc ca. 7000 linien
Die Gruppen werden durch die Zeigenfolge <BR> begrenzt. Die Anzahl der
Datenlinien ist leider schwankend zwischen 10 und 34 . Das Ziel ist, dass es
wiefolgt aussieht:
Spalte 1 .Spalte 2. etc.Spalte 34
Name1Name2... etc.Name34
Daten1v1.Daten1v2 etc.Daten1v34
Daten2v1.Daten2v2 etc.Daten2v34
.etc
Daten1vX.Daten1vX etc.Daten1vX
Ich habs versucht mit Makros unter Excell, mit Transponieren etc. Aber ich
kriegs nicht hin. Nun frage ich mich ob unter Escell eine Lösung möglich ist,
wenn ja,
kann mir da jemand helfen?
Vielen Dank im Vorraus
Willy
 

Lesen sie die antworten

#1 Claus Busch
28/10/2008 - 16:12 | Warnen spam
Hallo Willy,

Am Tue, 28 Oct 2008 04:24:01 -0700 schrieb Willy Steffen:

Die Gruppen werden durch die Zeigenfolge <BR> begrenzt. Die Anzahl der
Datenlinien ist leider schwankend zwischen 10 und 34 . Das Ziel ist, dass es
wiefolgt aussieht:
Spalte 1 .Spalte 2. etc.Spalte 34
Name1Name2... etc.Name34
Daten1v1.Daten1v2 etc.Daten1v34
Daten2v1.Daten2v2 etc.Daten2v34
.etc
Daten1vX.Daten1vX etc.Daten1vX



schreibe in dein Tabellenblatt2 die Überschriften von 1 bis 34 und
probiere es dann mal mit folgendem Makro:
Sub Transponieren()
Dim LRow As Long
Dim i As Long
Dim n As Long
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Dim Start As Long
Dim Ende As Long

'hier Tabellennamen anpassen
Set wks1 = Worksheets("Tabelle1")
Set wks2 = Worksheets("Tabelle2")

Application.ScreenUpdating = False

With wks1
'hier Bereiche anpassen
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
Start = 2
n = 2
For i = 2 To LRow
If .Cells(i, 1) = "<BR>" Then
Ende = i - 1
.Range(.Cells(Start, 2), .Cells(Ende, 2)).Copy
wks2.Range("A" & n).PasteSpecial xlPasteAll, _
Transpose:=True
Start = i + 2
i = i + 2
n = n + 1
End If
Next i
End With

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub



Mit freundlichen Grüssen
Claus Busch
Win XP Prof SP3 / Vista Ultimate
Office 2003 SP3 / 2007 Ultimate SP1

Ähnliche fragen