AW: user Form mit Suchen ergänzen
06.04.2019 10:50:31
Hajo_Zi
Hochgeladene Bilder können zwar als solche in Excel importiert werden, sind jedoch bei der Lösung von Problemen nicht sehr hilfreich, da man die eigentlichen Daten nicht ohne große und zeitraubende Umwege direkt in die Tabelle übertragen kann.
Schau mal hier
Eine hochgeladene Arbeitsmappe erhöht die Wahrscheinlichkeit, dass Du eine Lösung für Dein Problem erhältst.
Erstelle folglich bitte eine Demomappe, aus der deine Aufgabenstellung klar erkennbar ist und lade diese hoch.
Wenn du an Stelle einer Demomappe deine Originalmappe hochladen willst, diese aber sensible Daten enthält, solltest du diese Daten anonymisieren bzw. pseudonymisieren.
Falls Du den Download des Forums nicht benutzen möchtest beachte bitte: von unsicheren Servern file-upload lade ich keine Datei herunter (lt. Einschätzung meines Virenprogramms)
ption Explicit
Public Sub Find_Methode()
Dim WkSh_1 As Worksheet
Dim WkSh_2 As Worksheet
Dim lZeile As Long
Dim rZelle As Range
Dim sFundst As String
Dim sSuchbegriff As String
sSuchbegriff = "18"
If sSuchbegriff "" Then
Application.ScreenUpdating = False
Application.EnableEvents = False
'Set WkSh_1 = ThisWorkbook.Worksheets("Sicherung_Telefonliste")
Set WkSh_2 = ThisWorkbook.Worksheets("Tabelle1")
With WkSh_2.Columns(1)
'Set Rafound1 = Columns(1).Find("Erledigt", Range("A" & Rows.Count), xlFormulas, _
' xlWhole, , xlNext)
Set rZelle = .find(sSuchbegriff, , xlFormulas, _
xlWhole, , xlNext)
If Not rZelle Is Nothing Then
sFundst = rZelle.Address
Do
MsgBox rZelle.Address
' deine Aktionen mit rZelle.Offset(0,1)
' lZeile = WkSh_1.Cells(Rows.Count, 1).End(xlUp).Row + 1
' WkSh_2.Range("A" & rZelle.Row & ":H" & rZelle.Row).Copy
' WkSh_1.Range("A" & lZeile & ":H" & lZeile).PasteSpecial Paste:=xlValues
' WkSh_2.Range("A" & rZelle.Row & ":H" & rZelle.Row).Delete Shift:=xlUp
Set rZelle = .FindNext(rZelle)
Loop While Not rZelle Is Nothing And rZelle.Address sFundst
End If
End With
Application.EnableEvents = True
Application.CutCopyMode = False 'Zwischenspeicher löschen
Application.ScreenUpdating = True
'Set WkSh_1 = Nothing
Set WkSh_2 = Nothing
Set rZelle = Nothing
End If
End Sub
Beiträge von Werner, Luc, robert, J.O.Maximo und folgende lese ich nicht.
Die Beiträge werden auch ignoriert, es erfolgt keine Antwort.