Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

Liste nach Werten einer zweiten Liste durchsuchen

Frage Microsoft Microsoft Office

Mitglied: mr.lemon

mr.lemon (Level 1) - Jetzt verbinden

04.10.2010, aktualisiert 05.10.2010, 3900 Aufrufe, 21 Kommentare

Guten Tag zusammen,

ich komme gleich zu meinem Problem das mich schon lange ärgert, bzw. die Tatsache, dass es sicher eine einfache Lösung dafür gibt und ich sie nur nicht finde, da ich mich mit Excel zu wenig auseinander setze.

Ich Habe 2 Unterschiedliche listen.

Die eine Liste (liste 1) enthält neben ganz viel Text (es sind in excel exportierte E-Mails) immer im gleichen Abstand eine Seriennummern und nach diesen Seriennummern möchte ich in der Zweiten Liste (Liste 2) automatisch suchen und die gefunden Treffer auch irgendwie markieren, damit ich sie Hinterher per Autofilter von den trennen kann.

Das ist das eigentliche Problem, dass ich habe, wenn das funktioniert, währe es großartig, wenn man an stelle des "Markierens" bei einer Übereinstimmung einen Wert, der sich ebenfalls in (liste 1) befindet in die Zelle rechts von der gefunden Seriennummer schrieben könnte.

Ich habe 3 Bilder hinzugefügt, falls diese nicht genügend Infos hergeben einfach bescheid geben was benötigt wird.

Vielen dank im Voraus

a7e861261e6ecaccd5174d43076861f8 - Klicke auf das Bild, um es zu vergrößern

ebc308be3513d8e8227731abe0a067ea - Klicke auf das Bild, um es zu vergrößern

9941ee35ef7734f8e903273559c1c57f - Klicke auf das Bild, um es zu vergrößern
Mitglied: 76109
04.10.2010 um 18:06 Uhr
Hallo mr.lemon!

Du könntest es mal mit einem Makro versuchen.

Quellcode im VB-Editor in ein Modul einfügen und Tabellennamen anpassen:
01.
Const Sheet1 = "Liste1"         ' Tabellenname Liste 1 
02.
Const Sheet2 = "Liste2"         ' Tabellenname Liste 2 
03.
 
04.
Const SpalteSuchen = "A"        ' Liste 2 Spalte Suchen 
05.
Const SpalteValue = "B"         ' Liste 2 Spalte Wert 
06.
 
07.
Const TextSN = "Device S/N:"    ' Text mit Seriennummer 
08.
 
09.
Const Msg0 = "Seriennummer ? nicht gefunden!" 
10.
 
11.
Sub FindSerienNummer() 
12.
    Dim Found As Range, Token As Variant, SN As String 
13.
     
14.
    Token = Split(ActiveCell, TextSN) 
15.
     
16.
    If UBound(Token) = 1 Then 
17.
        SN = Trim(Token(1)) 
18.
         
19.
        If SN <> "" Then 
20.
            With Sheets(Sheet2) 
21.
               .AutoFilterMode = False 
22.
                  
23.
                Set Found = .Columns(SpalteSuchen).Find(SN, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False) 
24.
             
25.
                If Not Found Is Nothing Then 
26.
                     Token = Split(Cells(ActiveCell.Row - 4, SpalteSuchen), ":") 
27.
                    .Cells(Found.Row, SpalteValue) = Trim(Token(UBound(Token))) 
28.
                    .Columns(SpalteSuchen).AutoFilter Field:=1, Criteria1:=SN 
29.
                    .Activate 
30.
                    .Range("A1").Select 
31.
                Else 
32.
                     MsgBox Replace(Msg0, "?", SN), vbInformation, "Suchen..." 
33.
                End If 
34.
            End With 
35.
        End If 
36.
    End If 
37.
End Sub
Nachdem der Quellcode eingefügt wurde, wäre es sinnvoll, wenn Du das Makro unter <Extras><Makro><Makros><FindSeriennummer><Optionen> mit einer Tastenkombination verknüpfst (z.B. Strg+G).

Ablauf:
Du selektierst in Liste1 in Spalte A eine Zelle mit einer Seriennummer (z.B. "Device S/N: Q4571200357") und betätigst die Tasten Strg+G. Dann wird in der Liste2 nach der Seriennummer gesucht und in Spalte B der Wert eingetragen, der sich in Liste1 in der Zeile Seriennummer -4 befindet. Zusätzlich wird im Anschluß die Liste2 aktiviert und die Seriennummer per Autofilter angezeigt. Falls das Filtern und aktivieren der Liste2 entfallen soll, dann einfach in den Codezeilen 28-30 ein Kommentarzeichen (Hochkomma ') davor setzen oder löschen?

Falls die Seriennummer in Liste2 nicht existiert, wird eine Meldung ausgegeben.

Gruß Dieter
Bitte warten ..
Mitglied: mr.lemon
05.10.2010 um 16:20 Uhr
Hallo Dieter,

danke für die schnelle Antwort, ich habe den Quelltext als Makro eingefügt und eine Tastenkombination zum schnellstarten Definiert, allerdings gibt er den Fehler "Index außerhalb des gültigen Bereichs" aus, was bedeutet das?

Vielleicht noch eine kleine Information.

Das im ersten Bild oben gezeigte Beispiel ist nur ein Ausschnitt, da es mehrere Exportierte Mails sind stehen davon natürlich mehrere untereinander, meist so um die 30 Stück, wenn ich dich richtig verstanden habe müsste ich zur zeit noch für jede Seriennummer die Prozedur "Anklicken + Makro starten" durchführen, kann das eventuell automatisch ablaufen?

Vielen Dank im Voraus

Alex
Bitte warten ..
Mitglied: 76109
05.10.2010 um 17:05 Uhr
Hallo Alex!

Zitat von mr.lemon:

danke für die schnelle Antwort, ich habe den Quelltext als Makro eingefügt und eine Tastenkombination zum schnellstarten
Definiert, allerdings gibt er den Fehler "Index außerhalb des gültigen Bereichs" aus, was bedeutet das?
Dafür gibt es viele Möglichkeiten, aber ich vermute mal, dass es mit der 4.Zeile oberhalb der Zeile mit der Seriennummer zusammenhängt?
Diese Zeile sollte zumindest einen Doppelpunkt beinhalten?

Öffne mal den VB-Editor und wechsle wieder in die Sheetansicht und wiederhole den Vorgang, der zum Fehler führte. Wenn der Debugger eine Meldung ausgibt, auf den Button Debuggen klicken, dann sollte die in Frage kommende Codezeile gelb markiert sein. Zum Beenden der Makroausführung auf das Stop-Symbol (blaues Quadrat) klicken. Danach am besten die Codezeile und die beiden Zellinhalte für Seriennummer und Wert hier posten.

Das im ersten Bild oben gezeigte Beispiel ist nur ein Ausschnitt, da es mehrere Exportierte Mails sind stehen davon natürlich
mehrere untereinander, meist so um die 30 Stück, wenn ich dich richtig verstanden habe müsste ich zur zeit noch für
jede Seriennummer die Prozedur "Anklicken + Makro starten" durchführen, kann das eventuell automatisch ablaufen?
Meinst Du jetzt damit, dass alle Mails auf einmal automatisch abgearbeitet werden sollen und einfach nur die Werte in Liste2 eingetragen werden sollen?

Gruß Dieter
Bitte warten ..
Mitglied: mr.lemon
05.10.2010 um 18:01 Uhr
Hallo noch mal,

sorry da war ein Fehler meinerseits drin, ich wusste nicht, dass die beiden Tabellenblätter in einer Mappe stecken müssen, aber als ich gesehen habe, das du beide Listen mit "Sheet" bezeichnet hast, habe ich mir gedacht, dann sollten es vielleicht auch Sheet1 und Sheet2 EINER Mappe sein.

Somit gibt er jetzt auch keinen Fehler mehr aus, sondern dieses Resultat hier.

022cc3fb7d10721fa85e9bdd2bec27e1 - Klicke auf das Bild, um es zu vergrößern

Leider ohne den Wert einzutragen

Zu deiner zweiten Frage:
Ja, es währe genau das richtige, wenn am ende (nach dem Testlauf) aus allen Mails automatisch die Seriennummer ausgelesen werden und der dazugehörige Wert in „liste2“ „Spalte B“ geschrieben wird, dass er danach auch gleich schon den Autofilter anschmeißt, ist schon mehr als ich mir vorgestellt habe, passt aber super ^^


Gruß: Alex
Bitte warten ..
Mitglied: 76109
05.10.2010 um 19:23 Uhr
Hallo Alex!

In Deinem Screenshot sehe ich gerade das sich das Modell in Spalte I und nicht in Spalte B befindet. Weil aktuell wird der Wert ja in Spalte B eingetragen, die jedoch nicht sichtbar ist. Wenn's jedoch Spalte I sein soll, dann die Konstante SpalteValue = "B" entsprechend ändern.

Wenn alle EMails automatisch erfasst und die Werte in Liste2 eingetragen werden sollen, wird der Auto-Filter natürlich deaktiviert. In diesem Fall habe ich leider keine Ahnung, welche Filter-Kriterien angewendet werden könnten

Gruß Dieter
Bitte warten ..
Mitglied: mr.lemon
06.10.2010 um 11:20 Uhr
Hallo Dieter,

und erneut vielen Dank, ich habe die Konstante auf "I" geändert und schon funktioniert es.

Das einzige was fehlt, ist nun noch das automatische verarbeiten aller mails die untereinander stehen, dabei ist die Autofilter Funktion gar nicht so wichtig, wichtig ist nur, dass er den Vorgang den er nun beim ausführen des Makros mit einer Seriennummer durchführt ohne mein Zutun mit allen vornimmt.

Gibt es dafür vielleicht noch eine Möglichkeit?

Vielen Danke

Gruß Alex
Bitte warten ..
Mitglied: 76109
06.10.2010 um 14:30 Uhr
Hallo Alex!

Versuchs mal damit:
01.
Option Explicit 
02.
Option Compare Text 
03.
 
04.
Const Sheet1 = "Liste1"         ' Tabellenname Liste 1 
05.
Const Sheet2 = "Liste2"         ' Tabellenname Liste 2 
06.
 
07.
Const SpalteSuchen = "A"        ' Liste 2 Spalte Suchen 
08.
Const SpalteValue = "I"         ' Liste 2 Spalte Wert 
09.
 
10.
Const TextSN = "Device S/N:"    ' Text mit Seriennummer 
11.
 
12.
Const Msg0 = "Seriennummer ? nicht gefunden!" 
13.
 
14.
Sub TestFindSerienNummer() 
15.
    Dim List1 As Worksheet, Found As Range, Token As Variant, C As Range, SN As String, EndLine As Long 
16.
     
17.
    Set List1 = Sheets(Sheet1) 
18.
     
19.
    EndLine = Cells(Rows.Count, SpalteSuchen).End(xlUp).Row 
20.
     
21.
    For Each C In List1.Range(SpalteSuchen & "1:" & SpalteSuchen & EndLine) 
22.
        If C Like "*" & TextSN & "*" Then 
23.
            Token = Split(C, TextSN) 
24.
             
25.
            If UBound(Token) = 1 Then 
26.
                SN = Trim(Token(1)) 
27.
                 
28.
                If SN <> "" Then 
29.
                    With Sheets(Sheet2) 
30.
                       .AutoFilterMode = False 
31.
                          
32.
                        Set Found = .Columns(SpalteSuchen).Find(SN, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False) 
33.
                     
34.
                        If Not Found Is Nothing Then 
35.
                             Token = Split(List1.Cells(C.Row - 4, SpalteSuchen), ":") 
36.
                              
37.
                             If UBound(Token) > 0 Then 
38.
                                .Cells(Found.Row, SpalteValue) = Trim(Token(UBound(Token))) 
39.
                            End If 
40.
                        Else 
41.
                            MsgBox Replace(Msg0, "?", SN), vbInformation, "Suchen..." 
42.
                        End If 
43.
                    End With 
44.
                End If 
45.
            End If 
46.
        End If 
47.
    Next 
48.
End Sub
Gruß Dieter
Bitte warten ..
Mitglied: mr.lemon
14.10.2010 um 12:01 Uhr
Hallo Dieter,

danke nochmal für deine Hilfe, ich bin mit deinem neuen Makro genau so verfahren wie mit dem alten, allerdings gibt es garkein Resultat wenn ich es ausführe, nicht mal einen Fehler.

Gruß:

Alex
Bitte warten ..
Mitglied: 76109
14.10.2010 um 12:49 Uhr
Hallo Alex!

Mhm Sorry, lag vermutlich an der Codezeile 22 (geändert)?

Ersetze Deine alte Codezeile 22 durch die neu Codezeile 22


Gruß Dieter
Bitte warten ..
Mitglied: mr.lemon
25.11.2010 um 17:09 Uhr
Hallo Dieter,

sorry das ich mich so lange nicht gemeldet habe.

Habe dein Makro getestet und es funktioniert großartig danke noch mal.
Seriennummer suchen und den passenden wert in der zweiten Tabelle in der richtigen spalte eintragen funktioniert super.

Nur wie das immer so ist tauchen in der Praxis immer noch keine Problemchen auf.

Leider ist bei manchen extrahierten mails eine Zeile in der nur das Wort "empty" steht vorhanden und diese Zeile muss sich natürlich genau in die 4 Zeilen quetschen, die dein Makro zurück geht um den passenden Wert zu ermitteln.
Ich denke das einfachste wäre es, alle Zeilen, in denen nur das Wort "empty" steht zu löschen, dass sollte doch möglich sein oder?
Denn dann würde es wieder passen.

976d2fad4406ec7e808fba0a76c0cdc9 - Klicke auf das Bild, um es zu vergrößern

Das zweite Problem das ich nicht bedacht hatte ist, was passiert, wenn ein wert zwei mal auftaucht, bisher ist es so, dass dann in der Liste 2 in Spalte I einfach der erste wert überschrieben wird, somit geht aber dann nur eine Bestellung raus und nicht wie es müsste 2 oder 3, kann man in so einem Fall vielleicht den zweiten Wert hinzufügen ohne den ersten zu löschen?

Vielen Dank und eine schönen tag noch.

Gruß:

Alex
Bitte warten ..
Mitglied: 76109
27.11.2010 um 14:59 Uhr
Hallo Alex!

In Punkto weitere Bestellungen, wäre zunächst zu klären, ob es sich in Spalte I um Zahlenwerte handelt, die addiert werden sollen oder um Text, der in Form "Text1, Text2, ..." eingetragen werden soll?

Desweiteren, ob die Inhalte der Spalte I beim Makrostart gelöscht werden sollen?

Den letzten Code habe ich zunächst insoweit geändert, dass die "empty"-Zeilen gelöscht werden.
01.
Option Explicit 
02.
Option Compare Text 
03.
 
04.
Const Sheet1 = "Liste1"         ' Tabellenname Liste 1 
05.
Const Sheet2 = "Liste2"         ' Tabellenname Liste 2 
06.
 
07.
Const SpalteSuchen = "A"        ' Liste 2 Spalte Suchen 
08.
Const SpalteValue = "I"         ' Liste 2 Spalte Wert 
09.
 
10.
Const TextSN = "Device S/N:"    ' Text mit Seriennummer 
11.
 
12.
Const Msg0 = "Seriennummer ? nicht gefunden!" 
13.
 
14.
Sub TestFindSerienNummer() 
15.
    Dim List1 As Worksheet, Found As Range, Token As Variant, C As Range 
16.
    Dim SN As String, EndLine As Long, i As Long 
17.
     
18.
    Set List1 = Sheets(Sheet1) 
19.
     
20.
    EndLine = List1.Cells(List1.Rows.Count, SpalteSuchen).End(xlUp).Row 
21.
     
22.
    For i = 1 To EndLine 
23.
        If i > EndLine Then Exit For 
24.
        If List1.Cells(i, "A") Like "empty*" Then 
25.
            List1.Rows(i).Delete:  i = i - 1:  EndLine = EndLine - 1 
26.
        End If 
27.
    Next 
28.
     
29.
    For Each C In List1.Range(SpalteSuchen & "1:" & SpalteSuchen & EndLine) 
30.
        If C Like "*" & TextSN & "*" Then 
31.
            Token = Split(C, TextSN) 
32.
             
33.
            If UBound(Token) = 1 Then 
34.
                SN = Trim(Token(1)) 
35.
                 
36.
                If SN <> "" Then 
37.
                    With Sheets(Sheet2) 
38.
                       .AutoFilterMode = False 
39.
                          
40.
                        Set Found = .Columns(SpalteSuchen).Find(SN, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False) 
41.
                     
42.
                        If Not Found Is Nothing Then 
43.
                             Token = Split(List1.Cells(C.Row - 4, SpalteSuchen), ":") 
44.
                              
45.
                             If UBound(Token) > 0 Then 
46.
                                .Cells(Found.Row, SpalteValue) = Trim(Token(UBound(Token))) 
47.
                            End If 
48.
                        Else 
49.
                            MsgBox Replace(Msg0, "?", SN), vbInformation, "Suchen..." 
50.
                        End If 
51.
                    End With 
52.
                End If 
53.
            End If 
54.
        End If 
55.
    Next 
56.
End Sub
Gruß Dieter
Bitte warten ..
Mitglied: mr.lemon
06.12.2010 um 12:03 Uhr
Hi Dieter,

es handelt sich in Spalte I um Texte die hintereinander aufgeführt werden müssten nach dem muster

Wert1 / Wert2

Gelöscht werden müssen die werte nicht, da das Ergebniss in einer separaten Datei gespeichert wird.

Gruß:

Alex
Bitte warten ..
Mitglied: 76109
07.12.2010 um 00:44 Uhr
Hallo Alex!

Ersetze im letzen Code die Codezeile 46 durch diese Codezeilen:
01.
                                With .Cells(Found.Row, SpalteValue) 
02.
                                    If IsEmpty(.Value) Then 
03.
                                        .Value = Trim(Token(UBound(Token))) 
04.
                                    Else 
05.
                                        .Value = .Value & " / " & Trim(Token(UBound(Token))) 
06.
                                    End If 
07.
                                End With
Gruß Dieter
Bitte warten ..
Mitglied: mr.lemon
17.01.2011 um 16:03 Uhr
Hallo Dieter,

großartig, einfach super,

alles was wir besprochen haben funktioniert, aber ein problem gibt es noch, bei dem ich auch nicht weiss wie man es am besten löst, vielleicht hast du eine Idee, es geht um diese verflixte "empty Zeile".

Leider war meine Beobachtung in diesem Punkt nicht gründlich genug, denn in dieser einen zeile steht leider nicht immer "empty" sondern auch hin und wieder etwas anderes.
Was bedeutet das man mit dem Löschen dieser Zeile bei 80% der "Bestellungen/Mails" den benötigten abstand von 4 Zeilen erreicht, aber leider nicht bei 100%.

Es gibt also verschiedene Varianten:

976d2fad4406ec7e808fba0a76c0cdc9 - Klicke auf das Bild, um es zu vergrößern

f8e3b7917bdd9d8c74855ecb6e9caa1c - Klicke auf das Bild, um es zu vergrößern

Somit ist das löschen der "empty Zeile" leider nicht des Räzels Lösung und kann verworfen werden.

Da der Text "9.Toner Status:" konstant ist, hätte ich gedacht, mann kann sich vielleicht daran orientieren und anstatt 4 Zeilen nach oben zu gehen, eventuell soetwas wie "gehe nach oben BIS du in der Zeile "9.Toner Status:" angekommen bist

Allerdings kann ich das nicht recht einschätzen,daher meine Frage an dich nach einer passenden Lösung.

Ansonsten funktioniert es super was noch fehlen würde, ist ein Autofilder in Liste2 am ende, den setze ich bis jetzt nach dem durchlauf des Makros noch per Hand.

Vielen Dank im voraus
Bitte warten ..
Mitglied: 76109
17.01.2011 um 17:26 Uhr
Hallo mr.lemon!

Tja, so ein Ärger

Was mir aber jetzt erst auffällt, sind die Bezeichnungen am Anfang jeder Zeile. Trifft es immer zu, dass die beiden Dinge mit 8. und 12. gekennzeichnet sind?
Und/Oder enthält dieser Zeile immer den Text "*End Supply Type: Leer:"?

Gruß Dieter
Bitte warten ..
Mitglied: mr.lemon
18.01.2011 um 13:21 Uhr
Hi,

beides trifft zu

am Anfang der Relevanten Zeilen steht immer

12.Device S/N:

und

8.End Supply Type:
Bitte warten ..
Mitglied: 76109
18.01.2011 um 13:47 Uhr
Hallo!

Dann sollte es jetzt damit funktionieren:
01.
Option Explicit 
02.
Option Compare Text 
03.
 
04.
Const Sheet1 = "Liste1"                     'Tabellenname Liste 1 
05.
Const Sheet2 = "Liste2"                     'Tabellenname Liste 2 
06.
 
07.
Const SpalteSuchen = "A"                    'Liste 2 Spalte Suchen 
08.
Const SpalteValue = "I"                     'Liste 2 Spalte Wert 
09.
 
10.
Const TextSN = "*Device S/N:*"              'Text mit Seriennummer 
11.
Const TextTY = "*End Supply Type:*"         'Text mit Type 
12.
 
13.
Const Msg0 = "Die Aktion wurde aufgrund eines Fehlers abgebrochen!" 
14.
Const Msg1 = "Seriennummer ? nicht gefunden!" 
15.
 
16.
Sub FindSerienNummer3() 
17.
    Dim List1 As Worksheet, Token As Variant, SN() As String, TY() As String 
18.
    Dim Found As Range, C As Range, EndLine As Long, i As Long, x1 As Long, x2 As Long 
19.
     
20.
    Set List1 = Sheets(Sheet1) 
21.
     
22.
    EndLine = List1.Cells(List1.Rows.Count, SpalteSuchen).End(xlUp).Row 
23.
     
24.
    For Each C In List1.Range(SpalteSuchen & "1:" & SpalteSuchen & EndLine) 
25.
        If C Like TextSN Then 
26.
            Token = Split(C, ":") 
27.
            ReDim Preserve SN(x1) As String: SN(x1) = Trim(Token(UBound(Token))):  x1 = x1 + 1 
28.
        ElseIf C Like TextTY Then 
29.
            Token = Split(C, ":") 
30.
            ReDim Preserve TY(x2) As String: TY(x2) = Trim(Token(UBound(Token))):  x2 = x2 + 1 
31.
        End If 
32.
    Next 
33.
     
34.
    If x1 = 0 Or x1 <> x2 Then MsgBox Msg0, vbExclamation, "Daten einlesen...": Exit Sub 
35.
 
36.
    With Sheets(Sheet2) 
37.
       .AutoFilterMode = False 
38.
     
39.
        For i = 0 To UBound(SN) 
40.
            If SN(i) <> "" Then 
41.
                Set Found = .Columns(SpalteSuchen).Find(SN(i), LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False) 
42.
                         
43.
                If Not Found Is Nothing Then 
44.
                    With .Cells(Found.Row, SpalteValue) 
45.
                        If IsEmpty(.Value) Then .Value = TY(i) Else .Value = .Value & " / " & TY(i) 
46.
                    End With 
47.
                Else 
48.
                    MsgBox Replace(Msg1, "?", SN(i)), vbInformation, "Suchen..." 
49.
                End If 
50.
            End If 
51.
        Next 
52.
 
53.
       .Range("A1:K1").AutoFilter 
54.
    End With 
55.
     
56.
    MsgBox "Fertig!", vbInformation, "Meldung" 
57.
End Sub
Und wenn es zur Zufriedenheit funktioniert, dann könntest Du den Beitrag noch als Gelöst markieren

Gruß Dieter

[edit] Zusätzlicher Test Anzahl der eingelesenen Einträge = 0 und AutoFilter mit eingefügt [/edit]
Bitte warten ..
Mitglied: mr.lemon
19.01.2011 um 14:21 Uhr
Hallo Dieter,

leider gibt das Makro gleich beim starten die von dir eingetragene Msg0 "Die Aktion wurde aufgrund eines Fehlers abgebrochen!" aus

Der Autofilter müsste am Ende in Liste 2 von Spalte A bis K gesetzt werden.

Vielen Dank im Voraus

Gruß:

Alex
Bitte warten ..
Mitglied: 76109
19.01.2011 um 16:14 Uhr
Hallo Alex!

Zitat von mr.lemon:
leider gibt das Makro gleich beim starten die von dir eingetragene Msg0 "Die Aktion wurde aufgrund eines Fehlers
abgebrochen!" aus
Diesen Schutz habe ich eingebaut, um sicherzustellen, dass die erfassten Einträge von "Device.." und "End Supply.." zahlenmäßig gleich sind. Ich vermute, dass die Zeilen mit "End Supply.." nicht immer 2 Doppelpunkte beinhalten oder nicht bis zum 2. Doppelpunkt identisch sind (keine Ahnung?).

Den letzten Code, habe ich aus diesem Grunde nochmals geändert, wobei jeweils der Mindest-Text von Codezeile 10 und 11 (ohne *) in den Zellen vorhanden sein muss.

Also, versuchs nochmal!
Der Autofilter müsste am Ende in Liste 2 von Spalte A bis K gesetzt werden.
In welcher Zeile?

Gruß Dieter
Bitte warten ..
Mitglied: mr.lemon
20.01.2011 um 15:05 Uhr
Hallo Dieter,

der Fehler hatte anscheinend wirklich irgendwas mit mit den beiden Zeilen "Device" und "End Supply" zu tun, denn nachdem ich die Namen einfach per Copy & Paste ins Makro übertragen habe tauchte der Fehler so nicht mehr auf.

40b65c8902473abe5cdb999eec33b509 - Klicke auf das Bild, um es zu vergrößern

Allerdings tritt nun leider ein Indexfehler auf.

f6dc6aaa0333447e3672152ecf3f28f9 - Klicke auf das Bild, um es zu vergrößern

P.s. Sorry wegen der ungenauen Angabe,
der Filter müsste am Ende in der Zweiten Liste in Zeile 1 von Spalte A bis K gesetzt werden.

P.p.s. Wenn dir eine Tabelle zum testen Helfen würde, stelle ich diese natürlich in bereinigter Form gerne zur Verfügung

danke und Gruß:

Alex
Bitte warten ..
Mitglied: 76109
20.01.2011 um 16:16 Uhr
Hallo Alex!

Das funktioniert so nicht. Der Fehler kommt, weil nichts eingelesen wurde. Hab's ich im Code schonmal geändert, sodass auch in diesem Fall die Fehlermeldung ausgegeben wird.

Teste also bitte nochmal mit meinem Original-Skript.

Du kannst in dem betreffenden Sheet auch erstmal mit der normalen Such-Funktion nach diesen beiden Begriffen "Device S/N:" und "End Supply Type:" suchen lassen. Mit "Alle suchen", sollten die beiden Suchbegriffe Anzahlmäßig übereinstimmen.

Für die Codezeilen 10 und 11, so wie ich es formuliert habe, ist nur wichtig, das zumindest der Text (ohne die Wildcards*) in den Zellen enthalten sein muss. Die (*) am Anfang und Ende bedeuten, dass der davor- und danachstehende Text variable sein darf/muss (z.B. unterschiedliche Seriennummern), ebenso wird nicht zwischen Klein/Großschreibung unterschieden.

Den AutoFilter habe ich ebenfalls in den letzten Code mit eingefügt

Gruß Dieter
Bitte warten ..
Neuester Wissensbeitrag
Humor (lol)

Linkliste für Adventskalender

(3)

Information von nikoatit zum Thema Humor (lol) ...

Heiß diskutierte Inhalte
Router & Routing
gelöst Ipv4 mieten (22)

Frage von homermg zum Thema Router & Routing ...

Windows Server
DHCP Server switchen (20)

Frage von M.Marz zum Thema Windows Server ...

Exchange Server
gelöst Exchange 2010 Berechtigungen wiederherstellen (20)

Frage von semperf1delis zum Thema Exchange Server ...

Hardware
gelöst Negative Erfahrungen LAN-Karten (19)

Frage von MegaGiga zum Thema Hardware ...