Datensortier-Markro: Excel hängt sich weg

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Datensortier-Markro: Excel hängt sich weg von: tom
Geschrieben am: 23.03.2005 16:01:48

Hallo,

da ist folgendes Szenario: In Spalte A habe ich Adress-Daten importiert.
Dort lasse ich per Makro z.B. nach "Name" suchen. Dann wird per Makro
3 Zellen weiter nach unten gehüpft, weil da immer der zugehörige Eintrag steht.
Soweit sogut.

Ich habe mir vermutlich ein grausiges Makro gebastelt.
Excel denkt das auch und nimmt sich den Strick - hängt sich also auf :-)

Meine Fragen also:
Geht es einfacher? Wenn nein: Warum hängt sich das Teil weg?

Vielen Dank für Eure Zeit!

Viele Grüße, tom

Sub Nokiadaten_sortieren()
Range("A1").Select
Dim gefunden As Range
'
'
' Beginn sortieren
Name1:
    Range("A1").Select
    'In Spalte A nach vollständigem Begriff "Name" suchen:
    Set gefunden = Range("A:A").Find(what:="Name", lookat:=xlWhole)
    'Wenn "Name" gefunden wurd gehe zu Sprungmarke "Name2"
    If Not gefunden Is Nothing Then
    GoTo Name2
    'Wenn nicht "Name" gefunden wurde gehe zu Sprungmarke "Company1"
    Else
    GoTo Company1
    End If
Name2:
    Range("A1").Select
    Set gefunden = Range("A:A").Find(what:="Name", lookat:=xlWhole)
    If Not gefunden Is Nothing Then gefunden.Select
    ActiveCell.ClearContents
     ' 3 Zellen nach unten springen:
    ActiveCell.Offset(3, 0).Select
    Selection.Copy
     ' In nächste freie Zelle der Spalte D springen:
    Sheets("Kundeneingabe").Cells(Rows.Count, 4).End(xlUp)(2, 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    GoTo Name1
'
'
Company1:
    Range("A1").Select
    Set gefunden = Range("A:A").Find(what:="Company", lookat:=xlWhole)
    If Not gefunden Is Nothing Then
    GoTo Company2
    Else
    GoTo JobTitle1
    End If
Company2:
    Range("A1").Select
    Set gefunden = Range("A:A").Find(what:="Company", lookat:=xlWhole)
    If Not gefunden Is Nothing Then gefunden.Select
    ActiveCell.ClearContents
    ActiveCell.Offset(3, 0).Select
    Selection.Copy
    Sheets("Kundeneingabe").Cells(Rows.Count, 3).End(xlUp)(2, 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    GoTo Company1
'
'
JobTitle1:
    Range("A1").Select
    Set gefunden = Range("A:A").Find(what:="Job", lookat:=xlPart)
    If Not gefunden Is Nothing Then
    GoTo JobTitle2
    Else
    GoTo Adress1a
    End If
JobTitle2:
    Range("A1").Select
    Set gefunden = Range("A:A").Find(what:="Job", lookat:=xlPart)
    If Not gefunden Is Nothing Then gefunden.Select
    ActiveCell.ClearContents
    ActiveCell.Offset(3, 0).Select
    Selection.Copy
    Sheets("Kundeneingabe").Cells(Rows.Count, 5).End(xlUp)(2, 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    GoTo JobTitle1
Adress1a:
' Adress1a für Straße und Adresss1b für Ort
    Range("A1").Select
    Set gefunden = Range("A:A").Find(what:="Address", lookat:=xlWhole)
    If Not gefunden Is Nothing Then
    GoTo Adress2a
    Else
    GoTo Adress1b
    End If
Adress2a:
    Range("A1").Select
    Set gefunden = Range("A:A").Find(what:="Address", lookat:=xlWhole)
    If Not gefunden Is Nothing Then gefunden.Select
    ActiveCell.Offset(3, 0).Select
    Selection.Copy
    Sheets("Kundeneingabe").Cells(Rows.Count, 6).End(xlUp)(2, 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    GoTo Adress1a
Adress1b:
    Range("A1").Select
    Set gefunden = Range("A:A").Find(what:="Address", lookat:=xlWhole)
    If Not gefunden Is Nothing Then
    GoTo Adress2b
    Else
    GoTo Tel1
    End If
Adress2b:
    Range("A1").Select
    Set gefunden = Range("A:A").Find(what:="Address", lookat:=xlWhole)
    If Not gefunden Is Nothing Then gefunden.Select
    ActiveCell.ClearContents
    ActiveCell.Offset(4, 0).Select
    Selection.Copy
    Sheets("Kundeneingabe").Cells(Rows.Count, 7).End(xlUp)(2, 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    GoTo Adress1b
Tel1:
Range("A2").Select
Call ScreenAn
End Sub

Bild


Betrifft: AW: Datensortier-Markro: Excel hängt sich weg von: Fritz Hellbach
Geschrieben am: 23.03.2005 16:58:08

Hallo Tom,
mir ist nicht ganz klar, was Du willst.
Wenn Du alle Adressdaten in einer Spalte hast, der Name immer in der selben Zeile(z.B. jede 7. Zeile) steht und Du einen bestimmten Namen suchst, würde ich das folgendermaßen lösen:

Sub xxx()
Dim i&, LetzteZeile&
Dim Suchbegriff$
Dim Daten$
LetzteZeile = Cells.SpecialCells(xlCellTypeLastCell).Row
Suchbegriff = "Name"
For i = 1 To LetzteZeile Step 7
    If Cells(i, 1) = Suchbegriff Then
        Daten = Cells(i + 3, 1)
        ... weitere Verarbeitung(jenachdem, was Du mit gefundenen Einträgen vorhast)
    Else
        MsgBox ("nichts gefunden")
    End If
Next
End Sub



Bild


Betrifft: AW: Datensortier-Markro: Excel hängt sich weg von: tom
Geschrieben am: 23.03.2005 18:03:34

Hallo Fritz,

vielen Dank für Dein Posting.

Bitte stelle Dir das so vor:
Da ist eine Adressdatenbank (mit Name, Firma, Anschrift, Telefonnummer usw.),
die ich in Excel importieren soll.
Leider hat die Importdatei ein so doofes Format (keine brauchbaren Trennzeichen),
daß nach dem Import ALLE Informationen in Spalte A stehen, also sogar die
ehemaligen Überschriften.

Einziger Lichtblick: Die Informationen stehen immer im gleichen Abstand zur importierten Überschrift. Beispiel:
"Name" steht in Zelle A5 kann aber auch in Zelle A15 stehen. Der zugehörige Eintrag "Michael Meier" steht aber immer 3 Zellen unter "Name".

Daher habe ich ein Makro programmiert, was mir die Einträge suchen und
in eine Tabelle ausschneiden soll. Leider funktioniert das Makro nicht.

Dein Makrovorschlag geht daher nicht, weil z.B. "Name" nicht im z.B. 7er-Abstand
steht.

Dennoch bin ich Dir dankbar, daß Du mir gepostet hast. Vielleicht schaffst Du es
ja noch zu antworten.

Herzliche Grüße, tom


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Werte aus einer Spalte mit einer Matrix vergleiche"