Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
588to592
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
588to592
588to592
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Datensortier-Markro: Excel hängt sich weg

Datensortier-Markro: Excel hängt sich weg
23.03.2005 16:01:48
tom
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

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datensortier-Markro: Excel hängt sich weg
23.03.2005 16:58:08
Fritz
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

Anzeige
AW: Datensortier-Markro: Excel hängt sich weg
23.03.2005 18:03:34
tom
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
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige