Clever-Excel-Forum

Normale Version: Bitte um Hilfe ! Bekomme Formatierung nicht hin !
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
Seiten: 1 2
Hallo,

bis auf die letzte Zeile wandelt dieser Code die Adressen in eine Zeile um:

Code:
Sub T_1()
Dim rng As Range
With Application
    .FindFormat.Font.Size = 24
    .ScreenUpdating = False
End With

With ActiveSheet.UsedRange.Columns(1)

    Set rng = .Find("*", , , , , , , , True)
        Anf = rng.Address
        
    Do
    lr = rng.Row
    Set rng = .Find("*", rng, , , , , , , True)
        Range(Range(Anf), rng.Offset(-1)).Copy
            Cells(Rows.Count, 10).End(xlUp).Offset(1).PasteSpecial Transpose:=True
        Anf = rng.Address
    Loop While rng.Row > lr
End With

Application.ScreenUpdating = True
End Sub

Das Überprüfen überlasse ich gerne anderen.

mfg
@Fennek, @Rabe und alle anderen lieben Forums-Cracks !

Die Maske von Rabe wäre perfekt !

Also wenn einer das von Euch hinbekommen würde wäre das super ! :28: :28: 

Für den lieben Menschen der das hinbekommt wäre mir das sogar eine seeehr gute Flasche Wein wert ! :43: :43: 
Versprochen ! Eine Frau ein Wort ! Ein Mann ein Wörterbuch. So heißt doch der Spruch ...
Jetzt haben wir natürlich wieder das Problem mit dem Datenschutz. Ihr müsstet mir eine Adresse nennen -  huuuuuuuuuu ... 
Aber im Ernst, ich würde das dann gern w.o.g. honorieren weil ich damit komplett überfordert bin.


Einstweilen schon mal Danke für eure Bemühungen ! 

  :23: :23: :23: :23: :23: :23: :23: :23:
Hallo Isabell,

die Qualität der Daten ist nicht so überragend, aber in den meisten Fällen sollte es gehen. Die Datei ist password geschützt, das sende ich dir per pn.
Hallo Fennek,

das ist für andere User, die das gleiche oder ein ähnliches Problem haben, nicht sonderlich hilfreich. Dodgy
Code:
Sub T_1()
Dim rng As Range
With Application
    .FindFormat.Font.Size = 24
    .ScreenUpdating = False
End With

With ActiveSheet.UsedRange.Columns(1)

    Set rng = .Find("*", , , , , , , , True)
        Anf = rng.Address
        
    Do
    lr = rng.Row
    Set rng = .Find("*", rng, , , , , , , True)
        Range(Range(Anf), rng.Offset(-1)).Copy
            Cells(Rows.Count, 10).End(xlUp).Offset(1).PasteSpecial Transpose:=True
        Anf = rng.Address
    Loop While rng.Row > lr
End With

Application.ScreenUpdating = True
End Sub

'######## kleine Helfer #########

Sub PLZ()
Sp = "Q"
    lr = Cells(Rows.Count, Sp).End(xlUp).Row
    For i = 2 To lr
        With Cells(i, Sp)
            If IsNumeric(Left(.Value, 4)) Then .Insert Shift:=xlToRight
        End With
    Next i
End Sub

Sub Tel()
Sp = "S"
    lr = Cells(Rows.Count, Sp).End(xlUp).Row
    For i = 2 To lr
        With Cells(i, Sp)
            If Left(.Value, 3) = "Tel" Then .Insert Shift:=xlToRight
        End With
    Next i
End Sub

Sub WWW()
Sp = "W"
    lr = Cells(Rows.Count, Sp).End(xlUp).Row
    For i = 2 To lr
        With Cells(i, Sp)
            If Left(.Value, 3) = "www" Then .Insert Shift:=xlToRight
        End With
    Next i
End Sub
Hi Isabell,

wenn Du Deine Adressdatei, die Du im Forum hochgeladen hast (von mir wegen Datenschutz wieder aus dem Forum gelöscht), mit dem Makro von Fennek in eine Datei nach meinem Vorschlag (also jeweils alle Daten pro Person in eine Zeile) umgewandelt hast, dann bastelst Du Dir auf einem weiteren Arbeitsblatt eine Maske hin, in der dann die Daten angezeigt werden können. Jeweils die Daten in einzelne Zellen und davor oder darüber die Titel-Beschreibung, was einzugeben ist.

Wenn Du das hast, dann kannst Du die Datei mit 10-15 Dummy-Datensätzen wieder hier im Forum hochladen, dann zeigen Dir die Helfer, wie das mit dem Auslesen der Datensätze aus der Datenbank geht.
Als nächstes müssen dann die Makros erstellt werden, die Datensätze hinzufügen, ändern oder löschen. Das kommt aber erst im Nachgang.

Allgemein gesagt, ist das eine ganz normale Adressverwaltung (mit evtl. ein paar zusätzlichen Daten), von denen es im Netz Fantastillionen von Beispielen gibt. Auch hier bei uns im Forum wurde das Thema schon mehrmals angesprochen und gelöst.

Hier mal ein quick&dirty-Beispiel für die Maske mit einer intelligenten Tabelle für die Datenbank:

Arbeitsblatt mit dem Namen 'Maske'
ABCD
2IDFirmaText
32TestfirmaTest-Claim
4
5Ansprechpartner
6AnredeVornameNachname
7FrauMichaelaMusterfrau
8
9Straße und HausnummerPLZOrt
10Musterstr. 1512345Musterstadt
11
12TelefonTelefon (mobil)
130123/4567890
14
15E-MailWebseite / Internet
16M.Musterfrau@domain.dehttp://www.domain.de

NameBezug
Daten=Tabelle1

ZelleFormel
B3=SVERWEIS($A$3;Daten;2;0)
C3=SVERWEIS($A$3;Daten;3;0)
B7=SVERWEIS($A$3;Daten;4;0)
C7=SVERWEIS($A$3;Daten;5;0)
D7=SVERWEIS($A$3;Daten;6;0)
B10=SVERWEIS($A$3;Daten;7;0)
C10=SVERWEIS($A$3;Daten;8;0)
D10=SVERWEIS($A$3;Daten;9;0)
B13=SVERWEIS($A$3;Daten;10;0)
C13=SVERWEIS($A$3;Daten;11;0)
B16=SVERWEIS($A$3;Daten;12;0)
C16=SVERWEIS($A$3;Daten;13;0)
Verwendete Systemkomponenten: [Windows (32-bit) NT 6.01] MS Excel 2013
Diese Tabelle wurde mit Tab2Html (v2.6.0) erstellt. ©Gerd alias Bamberg

Arbeitsblatt mit dem Namen 'Datenbank'
ABCDEFGHIJKLM
2IDFirma / FirmierungClaimAnredeVornameNameStraße und HausnummerPostleitzahlStadtTelefonTelefon (mobil)MailadresseWebseite / Internet
31Konsilium Consultant KGAlways One Step Ahead!HerrHansKerisWankelstraße 470563Stuttgart0711-656728-101Hans.keris@konsiliumkg.dehttp://www.konsiliumkg.de
42TestfirmaTest-ClaimFrauMichaelaMusterfrauMusterstr. 1512345Musterstadt0123/456789M.Musterfrau@domain.dehttp://www.domain.de
Verwendete Systemkomponenten: [Windows (32-bit) NT 6.01] MS Excel 2013
Diese Tabelle wurde mit Tab2Html (v2.6.0) erstellt. ©Gerd alias Bamberg

Beispieldatei: [attachment=19229]
Seiten: 1 2