Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1016to1020
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Contest - Makro aufbohren -

Contest - Makro aufbohren -
21.10.2008 18:27:16
sockel939
Hallo Excelfreunde,
fcs hat dieses Makro (siehe Link) aufgebohrt.
https://www.herber.de/forum/messages/1018056.html
So nun zum eigentlichen Teil:
Suchmakro - ein Makro das in Excel nur nach einem Begriff, max mehrere mit Hilfe von Array sucht und findet.
Ich rufe hiermit alle Meister und Lehrlinge auf, ein Suchmakro zu schreiben welches 2 oder mehr begriffe
findet die in einer Zeile stehen. Und Zwar egel ob der erste in A und der letzte in AA. Wenn beide in einer
Zeile stehen dann einen Treffer anzeigen. Noch zeigt mir dieses Makro den und und Fall an. Also es findet
zwar beide, aber eben nicht geschlossen als Treffer sondern getrennt.
Als Bsp.: 2 Begriffe werden Gesucht :
Hallo+Nixda
Dann nur wenn beide in einer Zeile stehen einen Treffer ausgeben, und nicht weil er jeweils den einen und den anderen gefunden hat.
Andere Ideen sind natürlich erwünscht.
Also wer lust hat, einfach mitmachen, herauskommen soll endlich ein sauberes Suchmakro für alle dei auch nach mehr als einem Begriff suchen wollen und müssen.
Gruß
Tom

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Contest - Makro aufbohren -
21.10.2008 18:59:00
ransi
Okay
A1:A20000 enthält daten
Str1 und Str2 werden gesucht:
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit


Public Sub test()
Dim str1 As String
Dim str2 As String
Dim arr As Variant
Dim myDic As Object
Dim L As Long
Set myDic = CreateObject("Scripting.Dictionary")
str1 = "Hallo"
str2 = "NixDa"
Range("A1").CurrentRegion.Copy
arr = Split(rein, vbCrLf)
For L = 0 To UBound(arr)
    If arr(L) Like "*" & str1 & "*" Then
        If arr(L) Like "*" & str2 & "*" Then
            myDic(L + 1) = arr(L)
        End If
    End If
Next
If myDic.Count > 0 Then
    MsgBox "Treffer in Zeile(n): " & vbCrLf & Join(myDic.keys, vbCrLf)
    MsgBox Join(myDic.items, vbCrLf & vbCrLf)
End If
End Sub


Public Function rein() As String
Dim clp As New DataObject
With clp
    .GetFromClipboard
    rein = .GetText
End With
End Function

ransi
Anzeige
AW: Contest - Makro aufbohren -
21.10.2008 19:00:29
ransi
Meinte natürlich A1:AA20000.
ransi
AW: Contest - Makro aufbohren -
21.10.2008 19:05:00
ransi
Hallo
Und noch etwas kürzer:
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit


Public Sub test()
Dim str1 As String
Dim str2 As String
Dim arr As Variant
str1 = "Hallo"
str2 = "NixDa"
Range("A1").CurrentRegion.Copy
arr = Split(rein, vbCrLf)
arr = Filter(arr, str1, True)
arr = Filter(arr, str2, True)
MsgBox Join(arr, vbCrLf & vbCrLf)
End Sub


Public Function rein() As String
Dim clp As New DataObject
With clp
    .GetFromClipboard
    rein = .GetText
End With
End Function

ransi
Anzeige
beliebig viele Suchbegriffe
21.10.2008 19:28:41
ransi
Hallo
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit


Public Sub test()
Dim str1 As String
Dim arr As Variant
Dim I As Integer
str1 = "Hallo,NixDa,ABC,EFG,HIJ" 'Suchbegriffe mit Komma trennen
Range("A1").CurrentRegion.Copy
arr = Split(rein, vbCrLf)
For I = 0 To UBound(Split(str1, ","))
    arr = Filter(arr, Split(str1, ",")(I), True)
Next
MsgBox Join(arr, vbCrLf & vbCrLf)
End Sub


Public Function rein() As String
Dim clp As New DataObject
With clp
    .GetFromClipboard
    rein = .GetText
End With
End Function

ransi
Anzeige
AW: beliebig viele Suchbegriffe
21.10.2008 19:50:00
Andre´
Hallo,
bei mir kommt folgende Meldung
Userbild
MFG Andre
AW: beliebig viele Suchbegriffe
21.10.2008 20:23:54
Uduuh
Hallo,
setze einen Verweis auf Microsoft Forms
Gruß aus’m Pott
Udo

AW: beliebig viele Suchbegriffe
21.10.2008 20:43:07
sockel939
Das sieht schon sehr gut aus :o)
Gehen wir einen Schritt weiter -----
Es gibt in der Arbeitsmappe beliebig viele Blätter, die mit CommandButton angesteuert werden.
In Jedem Blatt tummeln sich hunderte Datensätze Von A1 bis ZZ64000
Jeder Datensatz umfasst etwa 100 Zeilen und wird durch eine Farblich markierte Zeile vom nächsten Getrennt .
Jeder Datensatz wurde Gruppiert.
Der Bereich zwischen den Farblich markierten Zeilen ist der eigentliche Datensatz.
Suche also ausweiten und Blatt für Blatt und Zeile für Zeile zwischen den Farblich markierten nach übereinstimmungen suchen.
Farbe erkennen mit z.B.
Select Case Cells(zeile, 1).Interior.ColorIndex
Case 6: 'Zeile überspringen und weiter
und wenn:
Case 35: ' Dann in nächstes Blatt wechseln
dann mal in die Tasten hauen.
Tom
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige