Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
592to596
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
592to596
592to596
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Adressen

Adressen
30.03.2005 16:29:52
Ben
Hallo Forum!
Ich habe eine excel datei mit adressen zur weiterverarbeitung bekommen.
die adressen(je 8 Einträge/Felder) sind allerdings alle in eine spalte untereinander geschrieben worden. So kann ich sie allerdings nicht weiterverarbeiten(exportieren/importieren in adressverwaltung).
Kann ich die Daten so sortieren, dass jede adesse in einer zeile mit 8 spalten angezeigt wird?
Danke und Gruss
Ben

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Adressen
30.03.2005 16:56:35
Frank
Hallo Ben,
im Prinzip ja, poste bitte ein par Beispieldaten!
Gruß
Frank.
AW: Adressen
30.03.2005 17:30:23
Frank
Hallo Ben,
hier eine Variante, die mit den geposteten Daten funktioniert:

Sub Ben()
Dim lngRowWS1 As Long
Dim lngRowWS2 As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim strPLZ As String
Dim strOrt As String
Dim strFirma1 As String
Dim strFirma2 As String
Dim strTel As String
Dim strWWW As String
Dim strEmail As String
Set ws1 = ActiveSheet
Set ws2 = Worksheets.Add(After:=ws1)
ws2.Name = "Adressen Neu"
ws1.Select
lngRowWS1 = 1
lngRowWS2 = 1
For lngRowWS1 = 1 To ws1.UsedRange.SpecialCells(xlCellTypeLastCell).Row
If Len(Range("B" & lngRowWS1) & "") = 0 Then
' Leerzeile
ElseIf Left(Range("B" & lngRowWS1), 2) = "D-" Then
' Neuer Eintrag, vorhandene Daten übertragen
If Len(strPLZ) = 0 Then
' Beim ersten Mal gibt es noch keine Daten!
Else
ws2.Cells(lngRowWS2, "A") = strPLZ
ws2.Cells(lngRowWS2, "B") = strOrt
ws2.Cells(lngRowWS2, "C") = strFirma1
ws2.Cells(lngRowWS2, "D") = strFirma2
ws2.Cells(lngRowWS2, "E") = strTel
ws2.Cells(lngRowWS2, "F") = strWWW
ws2.Cells(lngRowWS2, "G") = strEmail
lngRowWS2 = lngRowWS2 + 1
strOrt = ""
strFirma1 = ""
strFirma2 = ""
strTel = ""
strWWW = ""
strEmail = ""
End If
strPLZ = Range("B" & lngRowWS1)
ElseIf Len(strPLZ) > 0 And Len(strOrt) = 0 Then
strOrt = Range("B" & lngRowWS1)
ElseIf Len(strFirma1) = 0 Then
strFirma1 = Range("B" & lngRowWS1)
ElseIf Len(strFirma2) = 0 And Not IsNumeric(Trim(Left(Range("B" & lngRowWS1), 1))) Then
strFirma2 = Range("B" & lngRowWS1)
ElseIf IsNumeric(Trim(Left(Range("B" & lngRowWS1), 1))) Then
strTel = Range("B" & lngRowWS1)
ElseIf InStr(1, Range("B" & lngRowWS1), "@") = 0 Then
strEmail = Range("B" & lngRowWS1)
Else
strWWW = Range("B" & lngRowWS1)
End If
Next
End Sub

Viel Spaß
Frank.
Anzeige
AW: Adressen
30.03.2005 18:04:34
Ben
Herzlichen Dank!
Ben

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige