PDA

Vollständige Version anzeigen : Fehler in VBA Code: erweitertes Suchergebnis


Franz Beckenbauer
20.07.2012, 07:40
Hi Zusammen,

ich habe ein kleines Problem mit meinem Programierten Code in meiner Excelliste.

Ich hab mir ein kleines Suchfenster gebastellt, dass 1 Ergebnis aus Tabellenblatt 2, Tabellenblatt 3 ...usw. auf Tabellenbatt 1 überträgt (also die ganze Zeile rüber kopiert).

Nun möchte ich aber das er nicht nur 1 Ergebnis pro Tabellenblatt überträgt, sondern alle Ergebnisse. Denn auf jedem einzelnen Tabellenblatt kann es mehrere Treffer geben.

________________________________________________________________________________ _____________________
Private Sub CommandButton1_Click()

Dim WkSh_Q As Worksheet
Dim Wksh_Q2 As Worksheet
Dim WkSh_Z As Worksheet
Dim rZelle As Range
Dim a As Variant
Dim inti As Integer
Dim iZeile As Integer

a = Array(TextBox1.Text)

Application.ScreenUpdating = False

Set WkSh_Q = Worksheets("DHL") ' das Quell-Tabellenblatt
Set WkSh_Z = Worksheets("Tabelle1") ' das Ziel-Tabellenblatt

With WkSh_Q.Rows
For inti = 0 To UBound(a)
Set rZelle = .Find(a(inti), LookAt:=xlWhole, LookIn:=xlValues)
If Not rZelle Is Nothing Then
iZeile = iZeile + 1
WkSh_Q.Rows(rZelle.Row).Copy Destination:=WkSh_Z.Rows(iZeile + 1)
End If
Next inti
End With

Set Wksh_Q2 = Worksheets("UTI") ' das Quell-Tabellenblatt
Set WkSh_Z = Worksheets("Tabelle1") ' das Ziel-Tabellenblatt

With Wksh_Q2.Rows
For inti = 0 To UBound(a)
Set rZelle = .Find(a(inti), LookAt:=xlWhole, LookIn:=xlValues)
If Not rZelle Is Nothing Then
iZeile = iZeile + 1
Wksh_Q2.Rows(rZelle.Row).Copy Destination:=WkSh_Z.Rows(iZeile + 1)
End If
Next inti
End With

Set Wksh_Q3 = Worksheets("Schenker") ' das Quell-Tabellenblatt
Set WkSh_Z = Worksheets("Tabelle1") ' das Ziel-Tabellenblatt

With Wksh_Q3.Rows
For inti = 0 To UBound(a)
Set rZelle = .Find(a(inti), LookAt:=xlWhole, LookIn:=xlValues)
If Not rZelle Is Nothing Then
iZeile = iZeile + 1
Wksh_Q3.Rows(rZelle.Row).Copy Destination:=WkSh_Z.Rows(iZeile + 1)
End If
Next inti
End With

Set Wksh_Q4 = Worksheets("Gallmeister") ' das Quell-Tabellenblatt
Set WkSh_Z = Worksheets("Tabelle1") ' das Ziel-Tabellenblatt

With Wksh_Q4.Rows
For inti = 0 To UBound(a)
Set rZelle = .Find(a(inti), LookAt:=xlWhole, LookIn:=xlValues)
If Not rZelle Is Nothing Then
iZeile = iZeile + 1
Wksh_Q4.Rows(rZelle.Row).Copy Destination:=WkSh_Z.Rows(iZeile + 1)
End If
Next inti
End With

Set Wksh_Q5 = Worksheets("UTM") ' das Quell-Tabellenblatt
Set WkSh_Z = Worksheets("Tabelle1") ' das Ziel-Tabellenblatt

With Wksh_Q5.Rows
For inti = 0 To UBound(a)
Set rZelle = .Find(a(inti), LookAt:=xlWhole, LookIn:=xlValues)
If Not rZelle Is Nothing Then
iZeile = iZeile + 1
Wksh_Q5.Rows(rZelle.Row).Copy Destination:=WkSh_Z.Rows(iZeile + 1)
End If
Next inti
End With

Application.ScreenUpdating = True
End Sub
________________________________________________________________________________ ________________

Wenn jemand eine Lösung parat hat wäre das richtig cool.

Vielen Dank im Voraus.

Gruß
Franz

chris-kaiser
20.07.2012, 07:46
Hi

dann solltest du ein Findnext einbauen....
drücke mal bei find die Taste F1 im Codefenster, dann kommst du zu einem Bsp. mit Findnext.

chris-kaiser
20.07.2012, 08:41
Hi

wird dafür ein UF genommen?

hier mal der Code ein wenig gekürzt ;)

Private Sub CommandButton1_Click()
Dim WkSh_Q As Worksheet, Wksh_Q2 As Worksheet, Wksh_Q3 As Worksheet
Dim WkSh_Q4 As Worksheet, Wksh_Q5 As Worksheet, WkSh_Z As Worksheet
Dim rZelle As Range, firstmatch As String
Dim a As Variant
Dim inti As Integer
Dim iZeile As Integer
Dim ws
Set WkSh_Q = Worksheets("DHL") ' das Quell-Tabellenblatt
Set Wksh_Q2 = Worksheets("UTI") ' das Quell-Tabellenblatt
Set Wksh_Q3 = Worksheets("Schenker") ' das Quell-Tabellenblatt
Set WkSh_Q4 = Worksheets("Gallmeister") ' das Quell-Tabellenblatt
Set Wksh_Q5 = Worksheets("UTM") ' das Quell-Tabellenblatt
Set WkSh_Z = Worksheets("Tabelle1") ' das Ziel-Tabellenblatt

a = Split(TextBox1.Text, ",") '????? nach was soll getrennt werden?
ws = Array(WkSh_Q.Name, Wksh_Q2.Name, Wksh_Q3.Name, WkSh_Q4.Name, Wksh_Q5.Name)

Application.ScreenUpdating = False
For i = 0 To UBound(ws)
With Sheets(ws(i)).Rows
For inti = 0 To UBound(a)
Set rZelle = .Find(Trim(a(inti)), LookAt:=xlWhole, LookIn:=xlValues)
If Not rZelle Is Nothing Then
firstmatch = rZelle.Address
Do
iZeile = iZeile + 1
rZelle.EntireRow.Copy Destination:=WkSh_Z.Rows(iZeile + 1)
Set rZelle = .FindNext(rZelle)
Loop While Not rZelle Is Nothing And firstmatch <> rZelle.Address
Set rZelle = Nothing
firstmatch = ""
End If
Next inti
End With
Application.ScreenUpdating = True
Next
Unload Me
End Sub

Franz Beckenbauer
20.07.2012, 14:12
Hi Chris,

funzt wunderbar und danke für die verkürzung=)

Aber für was ist den diese Pasage?

a = Split(TextBox1.Text, ",") '????? nach was soll getrennt werden?

MFG
Franz

chris-kaiser
23.07.2012, 07:36
Hi

Aber für was ist den diese Pasage?

a = Split(TextBox1.Text, ",") '????? nach was soll getrennt werden?


ich dachte du willst mehrere Suchbegriffe eingeben?

den dein
a = Array(TextBox1.Text)

funktioniert nicht meiner Meinung nach....
wenn du nun mit , (Beistrich getrennt) Suchbegriffe in die Textbox eingibst wird nach allen diesen Suchbegriffen gesucht werden.

Franz Beckenbauer
23.07.2012, 08:29
TIP TOP.

So weit hab ich garnicht gedacht=)

Danke für deine Hilfe.

MFG
Franz