Excel VBA: Suchen und Ersetzen - Dialog

[sharky51]

Hallo zusammen,

mal wieder eine Frage an dieses kompetente Forum.
Ist es möglich den Suchen und Ersetzen-Dialog in einen Makroablauf zu integrieren oder nachzubauen.

Was will ich damit bezwecken?
Ich bekomme Listen mit langen Nummern-Reihen. Z.B. steht so etwas in der Zelle 3#4N0907063AN   #H008SX540#*K09RB8-03203.06.1616660125*=.
Aus diesen Nummern-Reihen muss ich händisch prüfen ob eine Teilnummer darin enthalten ist, z.B. die letzten 3 Ziffern 125.
Ist die Zelle gefunden in der diese Teilnummer vorkommt soll in der Zelle rechts daneben ein "x" eingetragen werden und/oder die Zelle farblich markiert werden.
Der Eingabedialog erst beendet werden wenn man ihn abbricht.

Vielleicht hat jemand eine Idee wie man dies umsetzen kann?

Vielen Dank!

[Fennek]

Hallo,

vba ist sehr gut geeignet, um einen Text zu durchsuchen, Teile zu ersetzen usw.

Aber, aus Erfahrung mit anderen Fragestellern, dürfte es nicht reichen, nur nach "125" zu suchen. Also es bedarf eines Überblick über die Möglichkeiten bevor man einen Code schreiben kann.

mfg

[sharky51]

Hallo,

folgender VBA-Code funktioniert für meine beschriebene Aufgabe schon ganz gut.

Code:

Public Sub FindText()
 Dim ws As Worksheet, Found As Range, rngNm As String
 Dim myText As String, FirstAddress As String, thisLoc As String
 Dim AddressStr As String, foundNum As Integer
 
 myText = InputBox("Suchbegriff eintragen - z.B.: xyz123")
 
 If myText = "" Then Exit Sub
 
 With ActiveSheet
 Set Found = .UsedRange.Find(what:=myText, LookIn:=xlValues, MatchCase:=False)
 
 If Not Found Is Nothing Then
   FirstAddress = Found.Address
   Do
     foundNum = foundNum + 1
     rngNm = .Name
     AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf
     thisLoc = rngNm & " " & Found.Address
     
     Sheets(rngNm).Select
     Range(Found.Address(RowAbsolute:=False, _
       ColumnAbsolute:=False)).Select
     
     myFind = MsgBox("Found one """ & myText & """ here!" & vbCr & vbCr & _
       thisLoc, vbInformation + vbOKCancel + vbDefaultButton1, "Your Result!")
     
     If myFind = 2 Then Exit Sub
     
     Set Found = .UsedRange.FindNext(Found)
     Selection.Interior.ColorIndex = 6
     Selection.Cells.Offset(0, 1).Value = "x"
     
   Loop While Not Found Is Nothing And Found.Address <> FirstAddress
 End If
End With

If Len(AddressStr) Then
 MsgBox "Found: """ & myText & """ " & foundNum & " times." & vbCr & _
   AddressStr, vbOKOnly, myText & " found in these cells"
Else:
 MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation
End If

End Sub

Leider weiß ich nicht wie ich es anstellen soll, dass nach dem ersten gefundenen Wert sich die Inputbox nicht gleich wieder schließt.
Die Inputbox soll so lange geöffnet bleiben bis ein Abbruch erfolgt...d.h. das Makro soll so lange aktiv bleiben um damit weitere Suchbegriffe zu finden ohne dass das Makro neu gestartet werden muss.

Geht das überhaupt mit einer Inputbox? Wenn nicht wäre ich über eine Idee dankbar!!

[schauan]

Hallöchen,

ich habe eher die Vermutung, dass die Inputbox gleich nach Betätigung des OK-Buttons zu geht und nicht erst nachdem der erste Wert gefunden wurde.

Wenn Du was offenes brauchst, dann müsstest Du ein Userform nehmen. Für das Design kannst Du das Aussehen der Inputbox abkupfern.

[Kuwer]

Hallo,

Wenn Du was offenes brauchst, dann müsstest Du ein Userform nehmen. Für das Design kannst Du das Aussehen der Inputbox abkupfern.

oder es wird immer wieder eine Inputbox geöffnet.

Gruß Uwe

[sharky51]

Ok,

vielen Dank für die Infos.
Dann werde ich mich mal mit einer Userform beschäftigen.

[snb]

So geht's auch:

Code:

Public Sub M_snb()
 usedrange.replace InputBox("Suchbegriff eintragen - z.B.: xyz123"),"x",1
end sub

[sharky51]

So, jetzt habe ich etwas mit einer Userform zusammengebastelt.

Code:

Private Sub CommandButton1_Click()
 Unload Me
End Sub

Code:

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
 myTextOffsetCol = TextBox2.Text 'welche Spalte für Markierung
 myTextMarkierungszeichen = TextBox3.Text    'Zeichen für Markierung der Fundstelle
 myTextHintergrundfarbe = TextBox4.Text  'Farbindex für Hintergrundfarbe
 myText = TextBox1.Text  'Suchtext
 If KeyCode = vbKeyReturn Then Call FindText
 Application.ThisWorkbook.RefreshAll
End Sub

Code:

Public Sub FindText()
 Dim ws As Worksheet, Found As Range, rngNm As String
 Dim FirstAddress As String, thisLoc As String
 Dim AddressStr As String, foundNum As Integer
 
  If myText = "" Then Exit Sub
 
 With ActiveSheet
   Set Found = .UsedRange.Find(what:=myText, LookIn:=xlValues, MatchCase:=False)
   
   If Not Found Is Nothing Then
     FirstAddress = Found.Address
     Do
       foundNum = foundNum + 1
       rngNm = .Name
       AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf
       thisLoc = rngNm & " " & Found.Address
       
       Sheets(rngNm).Select
       Range(Found.Address(RowAbsolute:=False, ColumnAbsolute:=False)).Select
       
       myFind = MsgBox("Found one """ & myText & """ here!" & vbCr & vbCr & _
         thisLoc, vbInformation + vbOKCancel + vbDefaultButton1, "Your Result!")
       
       If myFind = 2 Then Exit Sub
       
       Set Found = .UsedRange.FindNext(Found)
       If myTextMarkierungszeichen <> "" Or myTextOffsetCol <> "" Then
         Selection.Cells.Offset(0, myTextOffsetCol).Value = myTextMarkierungszeichen
       End If
       If myTextHintergrundfarbe <> "" Then
         Selection.Interior.ColorIndex = myTextHintergrundfarbe
       End If
     Loop While Not Found Is Nothing And Found.Address <> FirstAddress
   End If
 End With
 
 If Len(AddressStr) Then
   MsgBox "Found: """ & myText & """ " & foundNum & " times." & vbCr & _
     AddressStr, vbOKOnly, myText & " found in these cells"
Else:
   MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation
 End If
  Application.ThisWorkbook.RefreshAll
End Sub

Dank an alle für die Tipps.