Excel VBA - Application.WorksheetFunction.Match

jerry0110

Erfahrenes Mitglied
Hallo zusammen,

ich möchte gerne in einer Überschrift nach einem Text suchen um dann in der Spalte etwas zu machen.
Wenn ich die Spalte fest angebe, dann findet er natürlich die Spalte.

Hab jetzt mal einen Versuch nach meiner Logik gemacht. Klappt aber nicht.

Grund dafür ist, dass es sein kann, dass in der Excel Tabelle Spalten hinzugefügt werden und ich nicht immer wieder den Code anpassen möchte.

Visual Basic:
 Set suchbereich = Range("A1:BN1")
 Set source = ActiveWorkbook.Worksheets("Orig")
 sText1 = "Ticket an 2nd Line"
 
     For f = lastRowNr(source) To 1 Step -1
            With Worksheets("Orig")
                secondline = Application.WorksheetFunction.Match(sText1, suchbereich, 0)
                    If source.Range(secondline & f) = "fertig" Then
                        source.Range(secondline & f).Interior.ColorIndex = 4
                    ElseIf source.Range(secondline & f) = "" Then
                        source.Range(secondline & f).Interior.ColorIndex = 2
                    ElseIf source.Range(secondline & f) >= 0 Then
                        source.Range(secondline & f).Interior.ColorIndex = 6
                    End If
            End With
    Next f
 
Wenn ich dich recht verstanden habe, ist dein Suchbereich dynamisch (Kopfzeile, in welcher sich aber die Anzahl Spalten verändern kann --> BN1 kann BX1 werden)?
Müsste nicht
Set Suchbereich = Range("1:1") gehen?
 
Es kommt dann immer der Fehler für die Zeile

Dim secondline As Integer *Hab ich noch vergessen zu schreiben

Visual Basic:
secondline = Application.WorksheetFunction.Match(sText1, suchbereich, 0)

Unbenannt.PNG
 
Versuch mal folgendes:
Code:
secondline = Application.WorksheetFunction.Match(sText1, source.rows(1), 0)
Btw: Wieso setzt du source auf "Orig", wenn du später ein "With Worksheets("Orig") machst? Doppelt gemoppelt (und das "With" benutzt du nirgends danach)
 
Habe es jetzt so geschrieben:
Kommt aber immer noch der gleiche Fehler


Visual Basic:
secondline = Application.WorksheetFunction.Match(sText1, source.Rows(1), 1)

'letzte Zeile & Spalte im Ziel berechnen
lastRow = xlsGetLastRow(source)
lastCol = xlsGetLastCol(source)
    
    For f = lastRowNr(source) To 1 Step -1
                    If source.Range(secondline & f) = "fertig" Then
                        source.Range(secondline & f).Interior.ColorIndex = 4
                    ElseIf source.Range(secondline & f) = "" Then
                        source.Range(secondline & f).Interior.ColorIndex = 2
                    ElseIf source.Range(secondline & f) >= 0 Then
                        source.Range(secondline & f).Interior.ColorIndex = 6
                    End If
    Next f
 
Also ich hab jetzt mal ein paar Phantasiedaten bei mir getestet
Visual Basic:
Sub main()
Dim result As Long
Dim sTest As String

    sTest = "test 3"

    result = Application.WorksheetFunction.Match(sTest, Tabelle1.Rows(1), 1)

    Debug.Print result

End Sub
Kein Fehler. Ergebnis ist immer richtig.
Dein Bock muss woanderst liegen
 
So ich habe jetzt das hinbekommen. Hatte einen Schreibfehler.
Nur was jetzt passiert ist, dass er einen Fehler beim Range ausgibt.
Wenn ich den Debugger nutze dann sehe ich dass secondline den Wert 66 hat und das f den wert 820.
Das kann aber nicht sein, weil der Wert in Spalt F1 ist und ich nur 350 Zeilen habe.
 
Ich habe jetzt noch mal ausprobiert.
Habe statt Range habe ich cells genommen.
Jetzt findet er auch alles nur ändert er die Farben nicht.

Code:
secondline = Application.WorksheetFunction.Match(sText1, source.Rows(1), 0)

'letzte Zeile & Spalte im Ziel berechnen
lastRow = xlsGetLastRow(source)
lastCol = xlsGetLastCol(source)


    
    For f = lastRowNr(source) To 1 Step -1
                    If source.Cells(secondline, f) = "fertig" Then
                        source.Cells(secondline, f).Interior.ColorIndex = 4
                    ElseIf source.Cells(secondline, f) = "" Then
                        source.Cells(secondline, f).Interior.ColorIndex = 2
                    ElseIf source.Cells(secondline, f) >= 0 Then
                        source.Cells(secondline, f).Interior.ColorIndex = 6
                    End If
 
so ich habe jetzt noch eine Suche Funktion eingebaut. Im ersten Stepp zeigt er alle offenen Aufträge an. Dann in der Suche möchte ich noch nach z. B. der Straße suchen. Das funktioniert auch. Klicke ich dann den Datensatz an und gehe auf Ansicht, dann kommt jetzt eine Fehlermeldung. Die Fehlermeldung kommt beim CommandButton2_Click. Beim Punkt "UserForm3.TextBox_Betr_DSW.Text = ListBox1.List(ListBox1.ListIndex, 6)"

Visual Basic:
Private Sub CommandButton1_Click()
    Unload Me
End Sub

Private Sub CommandButton2_Click()


If ListBox1.ListIndex > 1 Then   'Eine Zeile ist angeklickt
   
    Load UserForm3
   
    UserForm3.TextBox_Ticketnummer.Text = ListBox1.List(ListBox1.ListIndex, 0)
    UserForm3.TextBox_St_Anfang.Text = ListBox1.List(ListBox1.ListIndex, 1)
    UserForm3.TextBox_St_Ende = ListBox1.List(ListBox1.ListIndex, 2)
    UserForm3.TextBox_Betr_Gebiet.Text = ListBox1.List(ListBox1.ListIndex, 3)
    UserForm3.TextBox_Betr_POP.Text = ListBox1.List(ListBox1.ListIndex, 4)
    UserForm3.TextBox_Betr_KR.Text = ListBox1.List(ListBox1.ListIndex, 5)
    UserForm3.TextBox_Betr_DSW.Text = ListBox1.List(ListBox1.ListIndex, 6)
    UserForm3.TextBox_Firmenname.Text = ListBox1.List(ListBox1.ListIndex, 7)
    UserForm3.TextBox_Adresse.Text = ListBox1.List(ListBox1.ListIndex, 8)
    UserForm3.TextBox_ASP.Text = ListBox1.List(ListBox1.ListIndex, 9)
    UserForm3.TextBox_Schadenstelle = ListBox1.List(ListBox1.ListIndex, 10)
    UserForm3.ComboBox_Kabeltyp.Text = ListBox1.List(ListBox1.ListIndex, 11)
    UserForm3.ComboBox_Darkfiber.Text = ListBox1.List(ListBox1.ListIndex, 12)
    UserForm3.ComboBoxWDM_Strecke = ListBox1.List(ListBox1.ListIndex, 13)
    UserForm3.ComboBox_DP_TYP = ListBox1.List(ListBox1.ListIndex, 14)
    UserForm3.TextBox_Betr_PK.Text = ListBox1.List(ListBox1.ListIndex, 15)
    UserForm3.TextBox_Betr_Grosskunden = ListBox1.List(ListBox1.ListIndex, 16)
    UserForm3.Textbox_Bemerkung.Text = ListBox1.List(ListBox1.ListIndex, 17)

    UserForm3.Show    'vbModal bzw. vbModeLess
   
End If

End Sub

Private Sub CommandButton3_Click()
    Dim c As Range
    Dim rngBereich As Range
    Dim lngAnzahl As Long
    Dim strFirst As String
   
    ListBox1.Clear
   
    With Sheets("Datentabelle")
        Set rngBereich = .Columns("A:Q")
        Set c = rngBereich.Find(txtSuche, LookIn:=xlValues, lookat:=xlPart)
        If Not c Is Nothing Then
            strFirst = c.Address
            Do
                ListBox1.AddItem .Cells(c.Row, 1)
                lngAnzahl = ListBox1.ListCount
                ListBox1.List(lngAnzahl - 1, 1) = .Cells(c.Row, 2)
                ListBox1.List(lngAnzahl - 1, 2) = .Cells(c.Row, 3)
                ListBox1.List(lngAnzahl - 1, 3) = .Cells(c.Row, 4)
                ListBox1.List(lngAnzahl - 1, 4) = .Cells(c.Row, 5)
                ListBox1.List(lngAnzahl - 1, 5) = .Cells(c.Row, 6)
                Set c = rngBereich.FindNext(c)
            Loop While Not c Is Nothing And c.Address <> strFirst
        End If
    End With
End Sub


Private Sub UserForm_Initialize()
Dim arr As Variant
Dim arrF() As Variant
Dim i As Long
Dim k As Long
Dim m As Long

arr = Range("A1").CurrentRegion

For i = 1 To UBound(arr)
    If arr(i, 19) = False Then
        m = m + 1
        For k = 1 To UBound(arr, 2)
            ReDim Preserve arrF(1 To UBound(arr, 2), 1 To m)
            arrF(k, m) = arr(i, k)
        Next
    End If
Next
ListBox1.ColumnCount = UBound(arrF)
ListBox1.Column = arrF
End Sub
 

Anhänge

  • Unbenannt.PNG
    Unbenannt.PNG
    4,7 KB · Aufrufe: 2
Zurück