Arbeitsblatt zeilenweise durchlaufen + Edit

25/05/2010 - 21:43 von Andreas Vogt | Report spam
Hallo,
ich habe ein Excelsheet mit Adressen in folgendem Format:

Andreas Vogt, Musterstrasse 1, 99999 Musterhausen, Telefon 0700...1
Andreas Vogt, Musterstrasse 1, 99999 Musterhausen, Telefax 0700...2


Ich möchte dass jede Adresse auf 1 Zeile gebracht wird, also so:
Andreas Vogt, Musterstrasse 1, 99999 Musterhausen, Telefon 0700...1,
Telefax 0700...

Könnt ihr mir da helfen?

Gruß Andreas
 

Lesen sie die antworten

#1 Andreas Vogt
25/05/2010 - 23:02 | Warnen spam
Hallo,
ok, habs nun selbst geschaft, war auch nicht so schwer.
Hier meine Lösung.

Gruß Andreas


Function test()
Dim i As Long
Dim adr1 As String
Dim adr2 As String
Dim Zcopy As String
Dim offset As Integer
Dim Aoffset As Integer
Dim eRow As Long
Dim eArr(150) As Long

On Error GoTo test_Error

For i = 1 To 200
adr2 = Tabelle1.Cells(i, 1) & ";" & Tabelle1.Cells(i, 2) & ";"
& Tabelle1.Cells(i, 3)
If adr1 = adr2 And adr1 <> "" Then
If eRow = 0 Then eRow = i - 1
Zcopy = Tabelle1.Cells(i, 7)
Tabelle1.Cells(eRow, 8 + offset) = Zcopy
offset = offset + 1
eArr(Aoffset) = i
Aoffset = Aoffset + 1
Else
offset = 0
eRow = 0
End If
adr1 = Tabelle1.Cells(i, 1) & ";" & Tabelle1.Cells(i, 2) & ";"
& Tabelle1.Cells(i, 3)
Next i

For i = UBound(eArr) To LBound(eArr) Step -1
If eArr(i) > 0 Then
Tabelle1.Rows(eArr(i)).Delete
End If
Next i

Exit Function

test_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in
procedure test of VBA Dokument Tabelle1"
End Function

Ähnliche fragen