Frage stellen

VBA Excel: Match Funktion - Mehrere Treffer

1k Aufrufe
Gefragt in Tabellenkalkulation von steffen2 Experte (6.4k Punkte)

Hallo,

ich habe auch mal wieder ein Excel-Problem. Hier der relevante Code-Abschnitt

            Sheets("Daten").Select
            If Not IsError(Application.Match(CLng(SuchDatum), Range("G5:G100"), 0)) Then
                VaMatch = Application.Match(CLng(SuchDatum), Range("G5:G100"), 0)
                Range("G5:G5").Select
                ActiveCell.Offset(VaMatch - 1, -5).Range("A1").Select
                Veranstaltungstext = Selection.Value

                Sheets("Monate").Select
                ActiveCell.Offset(0, 2).Range("A1:A1").Select
                ActiveCell.FormulaR1C1 = ActiveCell.FormulaR1C1 + " " + Veranstaltungstext

in der 6-spaltigen Liste in B5 bis G100 im Blatt "Daten" stehen Termine drin. In Spalte G das Datum. Der Text von Spalte B wird in dem Blatt "Monate" im Kalender an die passende Stelle eingefügt bzw ergänzt.

Das funktioniert so seit Jahren wunderbar. Aber jetzt kann es vorkommen, dass mehrere Termine am selben Tag stattfinden.

Benötige ich da eine andere Funktion? Oder gibt es da einen einfachen Trick?

Gruß Steffen2

7 Antworten

0 Punkte
Beantwortet von m-o Profi (22.9k Punkte)
Hallo Steffen,

poste doch mal den ganzen Code. In deinem Code wird viel mit Select und Offset gearbeitet. Mir erschließt sich aus dem Codeschnipsel jedenfalls nicht, wie die Zeile in der Zieltabelle "Monate" ausgewählt wird, in der der Text geschrieben wird (wahrscheinlich wird sie in einem anderen Codeteil gesucht / gewählt).

Und wie willst du mehrere Texte ausgeben? Zusammengefasst in eine Zelle oder in mehrere Zellen?

Eine kleine Beispieltabelle mit ein paar Dummydaten wäre ggf. nicht schlecht.

Gruß

M.O.
0 Punkte
Beantwortet von
Hallo M.O.

ja, das Ziel wird davor ausgewählt.Im Prinzip eine Schleife die 12* 31* durchlaufen wird. Für jeden Tag des Jahres.

Es gibt pro Tag nur eine Zelle, in der alle Termine am Ende drin stehen.
Und jetzt kann es passieren, dass in der Liste eben 2 Termine am selben Tag vorhanden sind.

Heute Abend kann ich auch noch etwas hochladen.

Gruß Steffen2
0 Punkte
Beantwortet von steffen2 Experte (6.4k Punkte)

https://supportnet.de/forum/?qa=blob&qa_blobid=7670931674147565646

hier die Datei. Ich habe alles entfernt, was nicht relevant ist.

Meine Datei basiert auf der 6 Jahre alten Datei, die ich mit Hilfe vom dem Thread damals erstellt habe:
https://supportnet.de/forum/2454449/excel-2010-vba-problem-mit-find-datum
Aber jetzt will ich das auch für einen zweiten Verein machen. Und da gibt es Terminüberschneidungen.

Am 2. April, sieht man, dass die Termine aus den getrennten Tabellen gemixt werden können. Da ist nur die Farbe falsch. Aber das kann ich problemlos von Hand jeweils anpassen. Das sind max 10 Treffer pro Jahr.

Aber z.B. am 5. April fehlt das Training A. Weil in der selben Liste schon das Training B drin ist.

Die Not-Lösung im Moment ist, alles was in "Daten" Spalte N rot wird von Hand einzupflegen.

Gruß Steffen2

0 Punkte
Beantwortet von m-o Profi (22.9k Punkte)
Hallo Steffen,

ich schaue mir das mal an.

Gruß

M.O.
0 Punkte
Beantwortet von m-o Profi (22.9k Punkte)
ausgewählt von steffen2
 
Beste Antwort

Hallo Steffen,

hier das überarbeitete Makro:

Sub Spalte1_Ferien_Feiertage()

Application.ScreenUpdating = False

'
' Spalte3 Veranstaltungen + Feiertage löschen
'
    Sheets("Monate").Select
    Range("E4:E34").Select
    Dim i As Integer
    For i = 0 To 11
        Selection.ClearContents
        With Selection
        End With
        With Selection.Font
            .Name = "Calibri"
            .Size = 8
            .Color = Black
        End With
        ActiveCell.Offset(0, 6).Range("A1:A31").Select
    Next i
    
'
' Spalte2 und dann 3 ROTE Farbe löschen - So bleibt wegen   =WOCHENTAG(A4;2)=7
'
    Sheets("Monate").Select
    Range("C4:C34").Select
    For i = 0 To 11
        With Selection.Font
            .Color = Black
        End With
        ActiveCell.Offset(0, 6).Range("A1:A31").Select
    Next i
    Range("D4:D34").Select
    For i = 0 To 11
        With Selection.Font
            .Color = Black
        End With
        ActiveCell.Offset(0, 6).Range("A1:A31").Select
    Next i
    

'
' eintragen beginnen
'
    Dim SuchDatum As Date
    Dim i_Zeile As Integer
    Dim i_Spalte As Integer
    Dim i_Zaehler As Integer
    Dim VaMatch As Variant
    Dim Feiertagstext As String
    Dim arrVeranstaltungen As Variant
    Dim strVeranstaltung As String

    
'
' Spalte3 Feiertage 1 (rot)
'
    For i_Spalte = 3 To 72 Step 6
        For i_Zeile = 4 To 34 Step 1
            Sheets("Monate").Select
            ActiveSheet.Cells(i_Zeile, i_Spalte).Select
            SuchDatum = Selection.Value

            Sheets("Daten").Select
            If Not IsError(Application.Match(CLng(SuchDatum), Range("G5:G12"), 0)) Then
                VaMatch = Application.Match(CLng(SuchDatum), Range("G5:G12"), 0)
                Range("G5:G5").Select
                ActiveCell.Offset(VaMatch - 1, -5).Range("A1").Select
                Feiertagstext = Selection.Value

                Sheets("Monate").Select
                ActiveCell.Offset(0, 2).Range("A1:A1").Select
                ActiveCell.FormulaR1C1 = ActiveCell.FormulaR1C1 + " " + Feiertagstext
                Selection.Font.Color = -16776961 'rot
                ActiveCell.Offset(0, -1).Range("A1:A1").Select
                Selection.Font.Color = -16776961 'rot
                ActiveCell.Offset(0, -1).Range("A1:A1").Select
                Selection.Font.Color = -16776961 'rot
            End If
        Next i_Zeile
    Next i_Spalte

'
' Spalte3 Feiertage 2 (rot Sonntag)
'
    For i_Spalte = 3 To 72 Step 6
        For i_Zeile = 4 To 34 Step 1
            Sheets("Monate").Select
            ActiveSheet.Cells(i_Zeile, i_Spalte).Select
            SuchDatum = Selection.Value

            Sheets("Daten").Select
            If Not IsError(Application.Match(CLng(SuchDatum), Range("G15:G24"), 0)) Then
                VaMatch = Application.Match(CLng(SuchDatum), Range("G15:G24"), 0)
                Range("G15:G15").Select
                ActiveCell.Offset(VaMatch - 1, -5).Range("A1").Select
                Feiertagstext = Selection.Value

                Sheets("Monate").Select
                ActiveCell.Offset(0, 2).Range("A1:A1").Select
                ActiveCell.FormulaR1C1 = ActiveCell.FormulaR1C1 + " " + Feiertagstext
                Selection.Font.Color = -16776961 'rot
            End If
        Next i_Zeile
    Next i_Spalte

'
' Spalte3 Feiertage 3 (schwarz)
'
    For i_Spalte = 3 To 72 Step 6
        For i_Zeile = 4 To 34 Step 1
            Sheets("Monate").Select
            ActiveSheet.Cells(i_Zeile, i_Spalte).Select
            SuchDatum = Selection.Value

            Sheets("Daten").Select
            If Not IsError(Application.Match(CLng(SuchDatum), Range("G27:G32"), 0)) Then
                VaMatch = Application.Match(CLng(SuchDatum), Range("G27:G32"), 0)
                Range("G27:G27").Select
                ActiveCell.Offset(VaMatch - 1, -5).Range("A1").Select
                Feiertagstext = Selection.Value

                Sheets("Monate").Select
                ActiveCell.Offset(0, 2).Range("A1:A1").Select
                ActiveCell.FormulaR1C1 = ActiveCell.FormulaR1C1 + " " + Feiertagstext
            End If
        Next i_Zeile
    Next i_Spalte

'
' Spalte3 Feiertage 4 (rot)
'
    For i_Spalte = 3 To 72 Step 6
        For i_Zeile = 4 To 34 Step 1
            Sheets("Monate").Select
            ActiveSheet.Cells(i_Zeile, i_Spalte).Select
            SuchDatum = Selection.Value

            Sheets("Daten").Select
            If Not IsError(Application.Match(CLng(SuchDatum), Range("G35:G46"), 0)) Then
                VaMatch = Application.Match(CLng(SuchDatum), Range("G35:G46"), 0)
                Range("G35:G35").Select
                ActiveCell.Offset(VaMatch - 1, -5).Range("A1").Select
                Feiertagstext = Selection.Value

                Sheets("Monate").Select
                ActiveCell.Offset(0, 2).Range("A1:A1").Select
                ActiveCell.FormulaR1C1 = ActiveCell.FormulaR1C1 + " " + Feiertagstext
                Selection.Font.Color = -16776961 'rot
                ActiveCell.Offset(0, -1).Range("A1:A1").Select
                Selection.Font.Color = -16776961 'rot
                ActiveCell.Offset(0, -1).Range("A1:A1").Select
                Selection.Font.Color = -16776961 'rot
            End If
        Next i_Zeile
    Next i_Spalte

'
' Spalte3 Feiertage 5 (schwarz)
'
    For i_Spalte = 3 To 72 Step 6
        For i_Zeile = 4 To 34 Step 1
            Sheets("Monate").Select
            ActiveSheet.Cells(i_Zeile, i_Spalte).Select
            SuchDatum = Selection.Value

            Sheets("Daten").Select
            If Not IsError(Application.Match(CLng(SuchDatum), Range("G49:G56"), 0)) Then
                VaMatch = Application.Match(CLng(SuchDatum), Range("G49:G56"), 0)
                Range("G49:G49").Select
                ActiveCell.Offset(VaMatch - 1, -5).Range("A1").Select
                Feiertagstext = Selection.Value

                Sheets("Monate").Select
                ActiveCell.Offset(0, 2).Range("A1:A1").Select
                ActiveCell.FormulaR1C1 = ActiveCell.FormulaR1C1 + " " + Feiertagstext
            End If
        Next i_Zeile
    Next i_Spalte
    
    
    
 'Veranstaltungen in Kalender übertragen
    

 'im Arbeitsblatt Daten in Spalte N die Einträge mit Datum zählen
    With Worksheets("Daten")
      For i_Zeile = 5 To .Cells(Rows.Count, 14).End(xlUp).Row
         If IsDate(.Cells(i_Zeile, 14).Value) = True Then i_Zaehler = i_Zaehler + 1
      Next i_Zeile
    
    'Array für Veranstaltungen redimensionieren
    '0 = Datum, 1 = Veranstaltung
    ReDim arrVeranstaltung(i_Zaehler, 1)
    'Variable für Zähler wieder zurücksetzen
    i_Zaehler = 0
    'nun Spalte N noch einmal durchlaufen und Daten einlesen
    For i_Zeile = 5 To .Cells(Rows.Count, 14).End(xlUp).Row
         If IsDate(.Cells(i_Zeile, 14).Value) = True Then
           i_Zaehler = i_Zaehler + 1
           arrVeranstaltung(i_Zaehler, 0) = .Cells(i_Zeile, 14).Value  'Daten aus Spalte N - Datum
           arrVeranstaltung(i_Zaehler, 1) = .Cells(i_Zeile, 9).Value   'Daten aus Spalte i - Text
         End If
      Next i_Zeile
     End With
    
 With Worksheets("Monate")
    'Spalten mit Kalender durchlaufen
    For i_Spalte = 3 To 72 Step 6
      'Zeilen des Kalenders durchlaufen
      For i_Zeile = 4 To .Cells(Rows.Count, i_Spalte).End(xlUp).Row
        'Variable für Veranstaltungstext mit Inhalt der Zelle füllen
        strVeranstaltung = .Cells(i_Zeile, i_Spalte + 2).Value
        'Kalenderdaten mit Daten aus Array vergleichen
        For i = 1 To i_Zaehler
          If .Cells(i_Zeile, i_Spalte).Value = arrVeranstaltung(i, 0) Then
             If strVeranstaltung = "" Then
                'falls kein Text vorhanden
                 strVeranstaltung = strVeranstaltung & arrVeranstaltung(i, 1)
              Else
                'falls Text in Variable vorhanden ist
                strVeranstaltung = strVeranstaltung & " " & arrVeranstaltung(i, 1)
             End If
          End If
        Next i
        .Cells(i_Zeile, i_Spalte + 2) = strVeranstaltung
      
      Next i_Zeile
    Next i_Spalte
      
 End With
   
  Application.ScreenUpdating = True

 Sheets("Daten").Select
 Range("P2:P2").Select

End Sub


Schau mal, ob das so funktioniert, wie du dir das vorstellst.

Gruß

M.O.

0 Punkte
Beantwortet von steffen2 Experte (6.4k Punkte)
Hallo M.O.

super. Danke!!

Das funktioniert sehr gut. Die grüne Farbe für die Veranstaltungen sind bei dir verloren gegangen. Die habe ich aber selbst an der passenden Stelle im Else-Zweig wieder rein gebaut.

Und ich muss mir angewöhnen, mehr Kommentare in meinen Code zu machen. Das hilft fürs Verstehen.

Gruß Steffen2
+1 Punkt
Beantwortet von m-o Profi (22.9k Punkte)

Hallo Steffen,

freut mich, dass alles so funktioniert, wie du willst. Die grüne Farbe hatte ich vergessen, aber das hast du ja erledigt wink.

Gruß

M.O.

...