Daten finden und komplette Zeile anzeigen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sepp,
lass mal die Combos aussen vor, es geht mir nur darum in SpalteC die PersoNr. zu finden, daraufhin, die komplette Zeile zu kopieren und diese Werte in ein anderes Blatt zu schreiben, damit ich wiederum mittels Formular auf diese Daten zugreifen kann. Ich verstehe nicht ganz, was da die Combos mit zutun haben....
Ich habe bereits einen Add-in gefunden, der das einigermassen kann, vielleicht kannst Du Dir den mal anschauen:
Option Explicit
Public strSuch As String


Sub Suchen_alle_Tabellen()
Dim wks As Worksheet
Dim rng As Range
Dim strAddress As String, strFind As String
Dim strRow As String
Dim bitch As String
strFind = InputBox("Bitte Suchbegriff eingeben:", Application.UserName, strSuch)
If strFind = "" Then Exit Sub
For Each wks In Worksheets
Set rng = wks.Cells.Find(strFind, lookat:=xlPart, LookIn:=xlFormulas)
If Not rng Is Nothing Then
strAddress = rng.Address
strRow = rng.Row
Rows(strRow).EntireRow.Copy
ActiveSheet.Paste Destination:=Worksheets("tabelle3").Range("a2:iv2")  'must save
'copies in variables and read out variables at end of routines!!!!
Do
Application.Goto rng, False
If MsgBox("Weiter", vbYesNo + vbQuestion) = vbNo Then Exit Sub
Set rng = Cells.FindNext(After:=ActiveCell)
If rng.Address = strAddress Then Exit Do
Loop
End If
Next wks
strSuch = strFind
MsgBox "Keine weiteren Fundstellen!", False, Application.UserName
Worksheets(1).Activate
Range("A1").Select
'Debug.Print strAddress
'Debug.Print strRow
'Worksheets(3).Activate
Debug.Print bitch
End Sub

ich würde gerne das ergebnis von untenstehenden Zeilen, in eine variable speichern, um sie später auszulesen, vielleicht hat da jemand ne idee?
Rows(strRow).EntireRow.Copy
ActiveSheet.Paste Destination:=Worksheets("tabelle3").Range("a2:iv2")

Hallo Ike!
Eine mögliche Lösung:
Du erstellst ein Tabellenblatt mit dem Namen "Ergebnis".
Der nachfolgende Code sucht in deinem datenblatt in der Spalte "C" nach
der Nummer aus der Textbox im Suchformular (anpassen!).
Die gefundenen Zeilen werden in "Ergebnis" Spaltenweise eingefügt.
In der ersten Zeile steht jeweils die Zeilennummer der Fundstelle!
Duch die zeilennummer kannst du dann leicht bestimmen woher die daten kommen.
Spaltenweise ist so sicher einfacher, weil du dann praktisch alle Infos zu
einer Personalnummer zusammengefasst hast.

Sub suchen()
Dim rng As Range
Dim sFirst As String
Dim sFind As String
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Dim srch As Worksheet
Dim arrF As Variant
Dim icol As Integer
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
Set wks1 = Sheets("Tabelle1") 'Tabelle mit denn Personalnummern
Set wks2 = Sheets("Tabelle2") 'Tabelle mit denn restlichen Daten
Set srch = Sheets("Ergebnis") 'Tabelle zur Ausgabe der Fundstellen
sFind = UserForm1.TextBox1 'anpassen
Set rng = wks1.Range("C:C").Find(What:=sFind, LookIn:=xlValues, LookAt:=xlWhole)
If Not rng Is Nothing Then
sFirst = rng.Address
Do
icol = icol + 1
srch.Cells(1, icol) = rng.Row
arrF = wks1.Rows(rng.Row)
srch.Range(srch.Cells(2, icol), srch.Cells(257, icol)) = Application.Transpose(arrF)
arrF = wks2.Rows(rng.Row)
srch.Range(srch.Cells(258, icol), srch.Cells(513, icol)) = Application.Transpose(arrF)
Set rng = wks1.Range("C:C").FindNext(rng)
Loop While rng.Address <> sFirst
End If
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Gruß Sepp

Sub Suchen_alle_Tabellen() Dim wks As Worksheet Dim rng As Range Dim strAddress As String, strFind As String Dim strRow As String Dim bitch As String strFind = InputBox("Bitte Suchbegriff eingeben:", Application.UserName, strSuch) If strFind = "" Then Exit Sub For Each wks In Worksheets Set rng = wks.Cells.Find(strFind, lookat:=xlPart, LookIn:=xlFormulas) If Not rng Is Nothing Then strAddress = rng.Address strRow = rng.Row Rows(strRow).EntireRow.Copy ActiveSheet.Paste Destination:=Worksheets("tabelle3").Range("a2:iv2") 'must save 'copies in variables and read out variables at end of routines!!!! Do Application.Goto rng, False If MsgBox("Weiter", vbYesNo + vbQuestion) = vbNo Then Exit Sub Set rng = Cells.FindNext(After:=ActiveCell) If rng.Address = strAddress Then Exit Do Loop End If Next wks strSuch = strFind MsgBox "Keine weiteren Fundstellen!", False, Application.UserName Worksheets(1).Activate Range("A1").Select 'Debug.Print strAddress 'Debug.Print strRow 'Worksheets(3).Activate Debug.Print bitch End Sub

Beliebteste Forumthreads (12 Monate)

Daten finden und komplette Zeile anzeigen

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Daten finden und komplette Zeile anzeigen

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread