bulwai
23.09.2008, aktualisiert am 24.09.2008
view4695
view8
0
Goto Top

Komplexere Suchfunktion in Excel

gelöstFrageVB for ApplicationsEntwicklung
Hallo Zusammen!

Also,...

Bei mir ist es ähnlich wie bei anderen...
Ich habe 10 Tabellen ca. und in 9 davon sind Artikelnummern + Info etc...
Auf dem ersten Tabellenblatt möchte ich eine Suchefunktion ein baun...
Hab bis jetzt es soweit hin bekommen das ich in der ersten Spalte die Artikelnummer angebe und dieser Artikel dann in den nachfolgenden Tabellen herausgesucht wird...

Aber,... die Suchfunktion spinnt noch bissal...
Die Funktion funktioniert nicht wenn ich nur einen Artikel eingebe...
Bei mehr als einem geht es,....

Der Code wo der fehler liegen muss sieht so aus:

Sub Suchen_Item2()

Dim Suche3, letzte, Suche As Variant
Dim Suche2 As Variant
Dim i, Row, j As Integer
Dim a, s1, s2, s3 As String
Dim b As String
Dim c As String
Dim d As String
Dim wks As Worksheet
Dim e As String
Row = 5

Sheets("Tabelle1").Activate

Range("A2").End(xlDown).Offset(1, 0).Select
letzte = ActiveCell.Row - 1

For i = 1 To letzte
Suche = Suche & Cells(i, 1).Value & " "

Next

Range("B6:G65536").Value = ""

Suche2 = Split(Suche)


nachfolgend kommen nur die Such der Tabellenblätter!

Ich hoffe ihr versteht ungefair was ich meine

MFG und danke im vorraus
Thomas
ShareTeilen
Auf Facebook teilen Auf Twitter teilen Auf Reddit teilen Auf Linkedin teilen

Content-ID: 97582

Url: https://administrator.de/contentid/97582

Ausgedruckt am: 23.11.2024 um 01:11 Uhr

8 Kommentare
Neuester Kommentar
Goto Top
bastla
bastla 23.09.2008 um 10:07:09 Uhr
Goto Top
Hallo bulwai und willkommen im Forum!

In welcher Zeile steht denn Dein erster Suchbegriff? Einerseits suchst Du danach erst ab Zeile 2 (Range("A2")), andereseits beginnst Du mit dem Auslesen ("For"-Schleife) in der Zeile 1 ...

Bedingt dadurch, dass Du auch an den letzten Suchbegriff noch ein Leerzeichen anhängst, bekommst Du außerdem in Suche2 ein Element zuviel - das lässt sich durch
Suche2=Split(Trim(Suche))
vermeiden.

Soferne es keinen besonderen Grund dafür gibt (den Rest Deines Codes kenne ich ja nicht), zuerst die Zelle unterhalb des letzten Suchbegriffes auszuwählen, und dann die Zeile oberhalb zu ermitteln, sollte (falls die Suchbegriffe tatsächlich erst ab A2 eingetragen sind) die folgende Version genügen:
letzte = Range("A1").End(xlDown).Row  

For i = 2 To letzte
    Suche = Suche & Cells(i, 1).Value & " "  
Next

Suche2 = Split(Trim(Suche))
MsgBox CStr(Ubound(Suche2) + 1) & " Suchbegriff(e) gefunden." 'nur als Demo  

Range("B6:G65536").Value = ""
Grüße
bastla
bulwai
bulwai 23.09.2008 um 10:42:13 Uhr
Goto Top
Danke für die Antwort.
Bloß.. die Suchergebnisse sollen dann in die rechts danebenbefindende Spalte eingetragen werden
bastla
bastla 23.09.2008 um 12:48:10 Uhr
Goto Top
Hallo bulwai!

Vielleicht holst Du in Deiner Beschreibung ein wenig weiter aus - derzeit kann ich den Zusammenhang zwischen dem eingangs beschriebenen (und inzwischen hoffentlich gelösten) Problem und der nebenan liegenden Spalte nicht erkennen ...

Grüße
bastla
bulwai
bulwai 23.09.2008 um 13:08:38 Uhr
Goto Top
http://images.lokalisten.de/photos/a/2008/09/23/13/00/464001_1222167954 ...

ich hoffe das ihr lokalisten habt und das bild sieht... ich bin bissi ungeschickt mit dem upload zeugs...
naja wenn ihr es hoffentlich seht dann seht ihr "LINKS(sorry) die sucheingaben(also die artikelnummer)
dann auf den button...
danach "sollten" alle tabellen durchsucht werden und in die spalte mit unter dem button eingetragen werden...
bastla
bastla 23.09.2008 um 14:54:28 Uhr
Goto Top
Hallo bulwai!

Anhand des Screenshots lässt sich zwar grundsätzlich erkennen, welches Ziel du anstrebst, aber damit ist noch immer nicht klar, auf welchem Stand sich Dein Script derzeit befindet, und natürlich noch weniger, welcher Teil des Scripts nicht (wunschgemäß) funktioniert ...

Grüße
bastla
bulwai
bulwai 23.09.2008 um 14:59:16 Uhr
Goto Top
Also der komplette Code sieht so aus...
und in diesem Code ist ein fehler das er bei einer Suche nach nur einem Artikel
einfach einen fehler bringt....
das möchte natürlich nicht =P
bin echt dankbar das hier so schnell antworten kommen danke schön

Sub Suchen_Item2()

Dim Suche3, letzte, Suche As Variant
Dim Suche2 As Variant
Dim i, Row, j As Integer
Dim a, s1, s2, s3 As String
Dim b As String
Dim c As String
Dim d As String
Dim wks As Worksheet
Dim e As String
Row = 5

Sheets("Tabelle1").Activate

letzte = Range("A2").End(xlDown).Row

For i = 2 To letzte
Suche = Suche & Cells(i, 1).Value & " "
Next

Suche2 = Split(Trim(Suche))

MsgBox CStr(UBound(Suche2) + 1) & " Suchbegriff(e) gefunden." 'nur als Demo

Range("B6:G65536").Value = ""
Suche2 = Split(Trim(Suche))

arrcount = letzte
'CSC - Infrastr. Management ####################################################################
Sheets("CSC - Infrastr. Management").Activate
For j = 1 To arrcount
Sheets("CSC - Infrastr. Management").Activate


For i = 1 To 100

If Cells(i, 12) = Suche2(j - 1) Then

ServiceName = Cells(i, 4).Value
ItemNR = Cells(i, 10).Value
MaterialNR = Cells(i, 12).Value
Delivery = Cells(i, 13).Value
Hardware = Cells(i, 14).Value
InformationX = Cells(i, 15).Value

End If


Next i
If Suche2(j - 1) = MaterialNR Then
Row = Row + 1
Sheets("Tabelle1").Activate
Cells(Row, 2).Value = MaterialNR
Cells(Row, 3).Value = ItemNR
Cells(Row, 4).Value = ServiceName
Cells(Row, 5).Value = Delivery
Cells(Row, 6).Value = Hardware
Cells(Row, 7).Value = InformationX
End If

MaterialNR = ""
Next j

'CSC - Service Support #########################################################################
Sheets("CSC - Service Support").Activate
For j = 1 To arrcount
Sheets("CSC - Service Support").Activate

For i = 1 To 100

If Cells(i, 12) = Suche2(j - 1) Then

ServiceName = Cells(i, 4).Value
ItemNR = Cells(i, 10).Value
MaterialNR = Cells(i, 12).Value
Delivery = Cells(i, 13).Value
Hardware = Cells(i, 14).Value
InformationX = Cells(i, 15).Value

End If

Next i
If Suche2(j - 1) = MaterialNR Then
Row = Row + 1
Sheets("Tabelle1").Activate
Cells(Row, 2).Value = MaterialNR
Cells(Row, 3).Value = ItemNR
Cells(Row, 4).Value = ServiceName
Cells(Row, 5).Value = Delivery
Cells(Row, 6).Value = Hardware
Cells(Row, 7).Value = InformationX

End If

MaterialNR = ""
Next j

'CSC - Service Delivery #########################################################################
Sheets("CSC - Service Delivery").Activate
For j = 1 To arrcount
Sheets("CSC - Service Delivery").Activate

For i = 1 To 100

If Cells(i, 12) = Suche2(j - 1) Then

ServiceName = Cells(i, 4).Value
ItemNR = Cells(i, 10).Value
MaterialNR = Cells(i, 12).Value
Delivery = Cells(i, 13).Value
Hardware = Cells(i, 14).Value
InformationX = Cells(i, 15).Value

End If

Next i
If Suche2(j - 1) = MaterialNR Then
Row = Row + 1
Sheets("Tabelle1").Activate
Cells(Row, 2).Value = MaterialNR
Cells(Row, 3).Value = ItemNR
Cells(Row, 4).Value = ServiceName
Cells(Row, 5).Value = Delivery
Cells(Row, 6).Value = Hardware
Cells(Row, 7).Value = InformationX

End If

MaterialNR = ""
Next j

'Service Packages PLUS #########################################################################
Sheets("Service Packages PLUS").Activate
For j = 1 To arrcount
Sheets("Service Packages PLUS").Activate

For i = 1 To 100

If Cells(i, 12) = Suche2(j - 1) Then

ServiceName = Cells(i, 4).Value
ItemNR = Cells(i, 10).Value
MaterialNR = Cells(i, 12).Value
Delivery = Cells(i, 13).Value
Hardware = Cells(i, 14).Value
InformationX = Cells(i, 15).Value

End If

Next i
If Suche2(j - 1) = MaterialNR Then
Row = Row + 1
Sheets("Tabelle1").Activate
Cells(Row, 2).Value = MaterialNR
Cells(Row, 3).Value = ItemNR
Cells(Row, 4).Value = ServiceName
Cells(Row, 5).Value = Delivery
Cells(Row, 6).Value = Hardware
Cells(Row, 7).Value = InformationX

End If

MaterialNR = ""
Next j


'Service Care Packages #########################################################################
Sheets("Service Care Packages").Activate
For j = 1 To arrcount
Sheets("Service Care Packages").Activate

For i = 1 To 100

If Cells(i, 11) = Suche2(j - 1) Then

ServiceName = Cells(i, 4).Value
ItemNR = Cells(i, 10).Value
MaterialNR = Cells(i, 11).Value
Delivery = Cells(i, 12).Value
Hardware = Cells(i, 13).Value
InformationX = Cells(i, 14).Value

End If

Next i
If Suche2(j - 1) = MaterialNR Then
Row = Row + 1
Sheets("Tabelle1").Activate
Cells(Row, 2).Value = MaterialNR
Cells(Row, 3).Value = ItemNR
Cells(Row, 4).Value = ServiceName
Cells(Row, 5).Value = Delivery
Cells(Row, 6).Value = Hardware
Cells(Row, 7).Value = InformationX

End If

MaterialNR = ""
Next j


Sheets("Tabelle1").Activate
Range("A2:A809").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("B6:G485").Select
Selection.Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A2:A468").Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.Cut
ActiveSheet.Paste
Selection.Cut
Range("A6").Select
ActiveSheet.Paste
Range("B6:G443").Select
Selection.Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A43").Select
End Sub
bastla
bastla 23.09.2008 um 17:58:12 Uhr
Goto Top
Hallo bulwai!

Den Suchteil habe ich (ua durch das Auslagern des Eintragens in ein eigenes Unterprogramm) ein wenig gestrafft, und wenn die Tabellenstruktur (hinsichtlich der verwendeten Spalten) durchgängig gleich ausgelegt wäre, ließe sich das Ganze noch etwas knapper fassen ...
Sub Suchen_Item2()
Row = 5
Sheets("Tabelle1").Activate  
letzte = Range("A1").End(xlDown).Row  
For i = 2 To letzte
    Suche = Suche & Cells(i, 1).Value & " "  
Next

Suche2 = Split(Trim(Suche))
Range("B6:G65536").Value = ""  

arrcount = UBound(Suche2)
'CSC - Infrastr. Management ####################################################################  
For j = 0 To arrcount
    With Sheets("CSC - Infrastr. Management")  
        For i = 1 To 100
            If .Cells(i, 12) = Suche2(j) Then
                ServiceName = .Cells(i, 4).Value
                ItemNR = .Cells(i, 10).Value
                MaterialNR = .Cells(i, 12).Value
                Delivery = .Cells(i, 13).Value
                Hardware = .Cells(i, 14).Value
                InformationX = .Cells(i, 15).Value
                Row = Row + 1
                Eintragen Row, 2, Array(MaterialNR, ItemNR, ServiceName, Delivery, Hardware, InformationX)
                Exit For
            End If
        Next i
    End With
Next j
'CSC - Service Support #########################################################################  
For j = 0 To arrcount
    With Sheets("CSC - Service Support")  
        For i = 1 To 100
            If .Cells(i, 12) = Suche2(j) Then
                ServiceName = .Cells(i, 4).Value
                ItemNR = .Cells(i, 10).Value
                MaterialNR = .Cells(i, 12).Value
                Delivery = .Cells(i, 13).Value
                Hardware = .Cells(i, 14).Value
                InformationX = .Cells(i, 15).Value
                Row = Row + 1
                Eintragen Row, 2, Array(MaterialNR, ItemNR, ServiceName, Delivery, Hardware, InformationX)
                Exit For
            End If
        Next i
    End With
Next j
'CSC - Service Delivery #########################################################################  
For j = 0 To arrcount
    With Sheets("CSC - Service Delivery")  
        For i = 1 To 100
            If .Cells(i, 12) = Suche2(j) Then
                ServiceName = .Cells(i, 4).Value
                ItemNR = .Cells(i, 10).Value
                MaterialNR = .Cells(i, 12).Value
                Delivery = .Cells(i, 13).Value
                Hardware = .Cells(i, 14).Value
                InformationX = .Cells(i, 15).Value
                Row = Row + 1
                Eintragen Row, 2, Array(MaterialNR, ItemNR, ServiceName, Delivery, Hardware, InformationX)
                Exit For
            End If
        Next i
    End With
Next j
'Service Packages PLUS #########################################################################  
For j = 0 To arrcount
    With Sheets("Service Packages PLUS")  
        For i = 1 To 100
            If .Cells(i, 12) = Suche2(j) Then
                ServiceName = .Cells(i, 4).Value
                ItemNR = .Cells(i, 10).Value
                MaterialNR = .Cells(i, 12).Value
                Delivery = .Cells(i, 13).Value
                Hardware = .Cells(i, 14).Value
                InformationX = .Cells(i, 15).Value
                Row = Row + 1
                Eintragen Row, 2, Array(MaterialNR, ItemNR, ServiceName, Delivery, Hardware, InformationX)
                Exit For
            End If
        Next i
    End With
Next j
'Service Care Packages #########################################################################  
For j = 0 To arrcount
    With Sheets("Service Care Packages")  
        For i = 1 To 100
            If .Cells(i, 11) = Suche2(j) Then
                ServiceName = .Cells(i, 4).Value
                ItemNR = .Cells(i, 10).Value
                MaterialNR = .Cells(i, 11).Value
                Delivery = .Cells(i, 12).Value
                Hardware = .Cells(i, 13).Value
                InformationX = .Cells(i, 14).Value
                Row = Row + 1
                Eintragen Row, 2, Array(MaterialNR, ItemNR, ServiceName, Delivery, Hardware, InformationX)
                Exit For
            End If
        Next i
    End With
Next j

'Sortierung etc  

End Sub

Sub Eintragen(R, C, Values)
    For i = 0 To UBound(Values)
        Cells(R, C + i).Value = Values(i)
    Next
End Sub
Das Sortieren / Umkopieren im Anschluss an das Suchen und Übertragen der Daten sieht nach aufgezeichnetem Makro aus - wenn Du die Aufzeichnung (mit auf das wirklich Nötige beschränkten Arbeitsschritten) nochmals durchführst, solltest Du auch diesen Teil noch optimieren können.
Noch als Anmerkung zu den weiteren Änderungen: Das zwischenzeitliche Aktivieren der übrigen Tabellen lässt sich durch Angabe des Blattes (vereinfacht durch "With"-Blöcke) vermeiden, und unter der Annahme, dass jeder Suchbegriff nur einmal in den einzelnen Tabellen steht, sorgt das vorzeitige Verlassen der "For i"-Schleife mit "Exit For" für etwas Performance-Gewinn.

Eine alternative Schreibweise (ohne Verwendung eines Unterprogrammes) könnte (am Beispiel Suche in der ersten Tabelle) so aussehen:
For j = 0 To arrcount
    With Sheets("CSC - Infrastr. Management")  
        For i = 1 To 100
            If .Cells(i, 12) = Suche2(j) Then
                Row = Row + 1
                Values = Array( _
                    .Cells(i, 10).Value, _
                    .Cells(i, 12).Value, _
                    .Cells(i, 4).Value, _
                    .Cells(i, 13).Value, _
                    .Cells(i, 14).Value, _
                    .Cells(i, 15).Value _
                    )
                Sheets("Tabelle1").Cells(Row, 2).Resize(1, UBound(Values) + 1) = Values  
                Exit For
            End If        
        Next i
    End With
Next j
Noch kürzer (da ja die Anzahl der zu übertragenden Zellen = 6) bekannt ist (aber etwas weniger übersichtlich face-wink):
For j = 0 To arrcount
    With Sheets("CSC - Infrastr. Management")  
        For i = 1 To 100
            If .Cells(i, 12) = Suche2(j) Then
                Row = Row + 1
                Sheets("Tabelle1").Cells(Row, 2).Resize(1, 6) = _  
                    Array(.Cells(i, 10), .Cells(i, 12), .Cells(i, 4), .Cells(i, 13), .Cells(i, 14), .Cells(i, 15))
                Exit For
            End If
        Next i
    End With
Next j
Zum Thema Variablendeklaration: Grundsätzlich ist es natürlich zu empfehlen, alle Variablen zu deklarieren und dann mit "Option Explicit" für mehr Sicherheit zu sorgen, allerdings sollte dann auch hinsichtlich der Typen bzw der tatsächlich verwendeten Variablen konsequent vorgegangen werden - so erzeugt etwa die Zeile
Dim i, Row, j As Integer
die Variablen "i" und "Row" als Variant, und nur "j" wird ein Integer - in VBA muss der Datentyp (anders als etwa in .NET) für jede einzelne Variable festgelegt werden, also
Dim i As Integer, Row As Integer, j As Integer
Du könntest die entsprechenden "Dim"-Statements für den obigen Code noch nachtragen (womit Du diesen Code dann auch gleich besser kennen lernst face-wink).

Grüße
bastla
bulwai
bulwai 24.09.2008 um 07:42:29 Uhr
Goto Top
Sau Geil.
Mercie dir... das funktioniert ja wunderbar =)
ich werde mich weiterdran noch damit beschäftigen und üben =P
danke dir nochmal..
ich hoffe das wenn ich weitere fragen habe, du mir da auch noch behilflich sein kannst XD
danke dir

mfg bulwai /thomas
gelöstFrageVB for ApplicationsEntwicklung
Mehr von bulwaibulwaiLocal Profil ausgegrautbulwai - 2 Kommentare
Heiß diskutiert
superfun2k24Sophos SFOS 20 DNAT funktioniert nichtsuperfun2k24 - 26 Kommentareuser217Kaufberatung Hardware - Hyper-V Cluster 3 Nodesuser217 - 25 KommentarePharaunIntel-E810 QSFP28 to Mikrotik QSPF+ mit 40Gbit VerbindungPharaun - 24 Kommentareprplemk2Testumgebung bauen (Grundlegend)prplemk2 - 19 KommentareaufdemmarsHP Z620 USB hat kein Strom beim Startenaufdemmars - 17 KommentareTJ.Hooker74Dom.Admin-Passwort ändern - Auswirkungen auf EX, HCW, AADCTJ.Hooker74 - 15 KommentaremaisenkaiserSwitch ohne STP ins Netzwerkmaisenkaiser - 13 KommentareJudgelgZertifikate in die Exchange Online GAL hochladenJudgelg - 13 KommentareadmtechEntwicklertagebuch: Release 6.4 - Filteradmtech - 13 KommentareUnluckyProccess1999Creo 4.0 Lizenz Server (LMTOOLS)UnluckyProccess1999 - 13 KommentareleberkaeseFB7590 ISDN Fax-Funktionleberkaese - 12 KommentareZZaaiiggaaEDIFACT - Keins vorhanden ?ZZaaiiggaa - 11 Kommentare