AW: Suchabfrage in andere Tabelle
13.08.2003 09:02:50
heiko
Hallo
Bestimmt nicht die beste Lösung, aber ich habe das so gemacht
Sub suche_K()
Dim zeil, spal, zähler As Integer
zähler = 3 'für Kopfzeilen in Tabelle 3
Sheets("TABLE").Select
'HIER sollte Schleife einsetzen
'suchen von Zellen mit Inhalt K
Cells.Find(What:="K", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True) _
.Activate
zeil = ActiveCell.Row 'übergibt die Zeilenzahl der aktiven Zelle an Vari. zeil
'Datum kopieren
Cells(zeil, 7).Activate
Selection.Copy
Sheets("Tabelle3").Select
Cells(zähler, 2).Activate
ActiveSheet.Paste
'Uhrzeit kopieren
Sheets("TABLE").Select
Cells(zeil, 8).Activate
Selection.Copy
Sheets("Tabelle3").Select
Cells(zähler, 3).Activate
ActiveSheet.Paste
'Ostwert kopieren
Sheets("TABLE").Select
Cells(zeil + 5, 3).Activate
Selection.Copy
Sheets("Tabelle3").Select
Cells(zähler, 7).Activate
ActiveSheet.Paste
'Nordwert kopieren
Sheets("TABLE").Select
Cells(zeil + 6, 2).Activate
Selection.Copy
Sheets("Tabelle3").Select
Cells(zähler, 8).Activate
ActiveSheet.Paste
'Höhe kopieren
Sheets("TABLE").Select
Cells(zeil + 7, 2).Activate
Selection.Copy
Sheets("Tabelle3").Select
Cells(zähler, 9).Activate
ActiveSheet.Paste
'Punktnummer suchen
Sheets("TABLE").Select
pnr = Cells(zeil, 3).Value
Sheets("Tabelle3").Select
Cells(zähler, 1).Value = pnr
Sheets("Tabelle2").Select
'Cells.Find funktioniert nicht
Cells.Find(What:=pnr, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
zähler = zähler + 1
Sheets("TABLE").Select
'Schleife
End Sub
Grobe Erklärung:
Ich suche in der Tabelle Table nach K (könnte Dein DAN sein), ermittle die aktuelle Zeile(Row), speichere die Zeilennummer in zeil und hole mir dann Werte, die zu der Position vom gefundenen K in bestimmten Zellen stehen (bei Die selbe Zeile 2 Salten weiter vgl. bei mir Datum und Uhrzeit und kopiere diese Werte dann in ein Tabellenblatt 3.
Ein Tabellenblatt Table sowie Tabelle 3 muss vorhandensein beim Probieren oder Namen ändern.
Deine Suche sollte allerdings über eine Inputbox kreiert werden (siehe auch Beitrag heiko weiter unten)
Ev. hilft's.
Gruß heiko