Datenwirrwar entschlüsseln

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Werner,
da die Daten nicht einheitlich sind, hier mal was mit Formeln. Allerdings muß dann noch etwas angehübscht werden und der Rechner darf auch keine lahme Gurke sein!

Name

Namenszusatz 1

Namenszusatz 2

Straße

Plz Ort

Tel

Fax

INTERNET

MAIL

Franz Bader Schotterwerk

Bundesstr. 317

79868 Feldberg

Tel.: 07655 / 249

Fax: 07655 / 1409

Bundesstr. 317

Bau-Union GmbH & Co.

Vereinigte Schotterwerke KG

Flözlinger Str. 37

78658 Zimmern

Tel.: 0741 / 9287-0

Fax: 0741 / 9287-20

info@bau-union.com

www.bau-union.com

79868 Feldberg

WAHR

Jakob Bauer Söhne KG

Schotterwerk

Silcherstr. 1

73268 Erkenbrechtsweiler

Tel.: 07026 / 95006-0

Fax: 07026 / 95006-30

verwaltung@bauer-schotterwerk.de

www.bauer-schotterwerk.de

Tel.: 07655 / 249

Schotterwerk Blessing GmbH per:

Uhl Kies- und Baustoffges.mbH

Vorlandstr. 1

77756 Hausach

Tel.: 07831 / 7890

Fax: 07831 / 7475

info@uhl-beton.de

www.uhl-beton.de

Fax: 07655 / 1409

bmk Steinbruchbetriebe

GmbH & Co. KG

Robert-Bopp-Straße 2

74388 Talheim

Tel.: 07133 / 186-0

Fax: 07133 / 6068

info@bmk-Steinbruchbetriebe.com

www.bmk-Steinbruchbetriebe.com

Wilhelm Bohnert GmbH & Co. KG

Ruhesteinstr. 41

77883 Ottenhöfen

Tel.: 07842 / 947-126

Fax: 07842 / 947-200

info@wibo-ottenhoefen.de

www.wibo-ottenhoefen.de

Schotterwerk

Brugger GmbH

Schillerstr. 9

78589 Dürbheim

Tel.: 07424 / 2578

Fax: 07424 / 501926

schotter-brugger @t-online.de

schotter-brugger@t-online.de

Alfred Dörflinger GmbH

Granit- und Schotterwerk

Außerort Malsburg 17

79429 Malsburg-Marzell 1

Tel.: 07626 / 205

Fax: 07626 / 6505

Doerflinger.GmbH@t-online.de

Klaus Reimold GmbH

Muschelkalkschotterwerk

Tief-, Kanal- u. Straßenbau

Streichenberger Str. 30

75050 Gemmingen

Tel.: 07267 / 9120-0

Fax: 07267 / 9120-80

Bau-Union GmbH & Co.

#ZAHL!

Vereinigte Schotterwerke KG

#ZAHL!

Zelle	Formel
D2	=INDEX($A:$A;VERGLEICH($H2;$A$1:$A$4500;0)-4)
E2	=INDEX($A:$A;VERGLEICH($H2;$A$1:$A$4500;0)-3)
F2	=INDEX($A:$A;VERGLEICH($H2;$A$1:$A$4500;0)-2)
G2	=INDEX($A:$A;VERGLEICH($H2;$A$1:$A$4500;0)-1)
H2	{=INDEX(A:A;KKLEINSTE(WENN(ISTZAHL(LINKS($A$1:$A$4500;5)*1);ZEILE($1:$4500));ZEILE(A1)))}
I2	=INDEX($A:$A;VERGLEICH($H2;$A$1:$A$4500;0)+SPALTE(A1))
J2	=INDEX($A:$A;VERGLEICH($H2;$A$1:$A$4500;0)+SPALTE(B1))
K2	=INDEX($A:$A;VERGLEICH($H2;$A$1:$A$4500;0)+SPALTE(C1))
L2	=INDEX($A:$A;VERGLEICH($H2;$A$1:$A$4500;0)+SPALTE(D1))

Achtung, Matrixformel enthalten!

Die geschweiften Klammern{} werden nicht eingegeben.

Verlassen Sie den Zelleneditor mit Strg+Shift + Enter, statt Enter alleine.

VG René

Option Explicit Sub Zerlege() Dim lngZ As Long, zz As Long, nn As Long Dim pTel As Long, mm As Long, arrE(), ee As Long lngZ = Cells(Rows.Count, 1).End(xlUp).Row ReDim arrE(1 To 9, 1 To lngZ) zz = 0 Do While zz 3 Then arrE(2, ee) = Cells(zz + 1, 1) ' Zusatz1 If pTel > 4 Then arrE(3, ee) = Cells(zz + 2, 1) ' Zusatz2 arrE(4, ee) = Cells(zz + pTel - 2, 1) ' Straße arrE(5, ee) = Cells(zz + pTel - 1, 1) ' PLZ Ort arrE(6, ee) = Cells(zz + pTel - 0, 1) ' Tel If Left(Cells(zz + pTel + 1, 1), 4) = "Fax:" Then _ arrE(7, ee) = Cells(zz + pTel + 1, 1) ' Fax For mm = 2 To nn - pTel - 1 If Left(Cells(zz + pTel + mm, 1), 4) = "www." Then arrE(8, ee) = Cells(zz + pTel + mm, 1) ' Web ElseIf InStr(Cells(zz + pTel + mm, 1), "@") > 0 Then arrE(9, ee) = Cells(zz + pTel + mm, 1) ' Mail End If Next mm zz = zz + nn Loop ReDim Preserve arrE(1 To 9, 1 To ee) Cells(2, 4).Resize(ee, 9) = Application.Transpose(arrE) End Sub

Option Explicit Sub Zerlege2() Dim lngZ As Long, arrQ, zAnf As Long, zEnd As Long Dim zTel As Long, zz As Long, arrE(), ee As Long lngZ = Cells(Rows.Count, 1).End(xlUp).Row arrQ = Application.Transpose(Cells(1, 1).Resize(lngZ + 1)) ReDim arrE(1 To 9, 1 To lngZ) zAnf = 1 Do While zAnf 0 Then arrE(9, ee) = arrQ(zz) ' Mail End If Next zz zAnf = zEnd + 2 Loop ReDim Preserve arrE(1 To 9, 1 To ee) Cells(2, 4).Resize(ee, 9) = Application.Transpose(arrE) End Sub

Fehlerbeschreibungen Beschränke Dich nicht auf die lapidare Feststellung Excel meldet Fehler; gib die exakte Fehlermeldung an. Stoppt Excel einen VBA-Code, gib die exakte Zeile des Programmabbruchs an.

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread