Was ist das nur für ein Filter ...
25.09.2021 09:40:26
Fred
ich muss nochmals auf meine gestern gestellte Frage (Problem mit der Texterkennung) zurück kommen.
Das ist so eine ganz seltene Phase, wo ich mal selbst so richtig frustiert wegen Excel und meinem beschränkten Wissen bin,- aber dran bleibe.
Also; Ich bestimme durch Kriterium, welche Spielpaarung mit welcher Mannschaftbeteiligung von Blatt "BasisNeu" nach Blatt "Auswahl_1" kopiert werden.
Das Kriterium des "Teamnamens" wird durch eine Liste mit deren Namen durch eine Schleife in das Blatt "Kriteien" eingetragen.
Das geschieht derzeit so:
Sub schleife_1()
Dim t As Double ' Zeitmessung
t = Timer
Dim wksBlatt As Worksheet
Dim lngLastRow As Long
Dim lngC As Long
Application.ScreenUpdating = False
Set wksBlatt = ActiveSheet
With wksBlatt
lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For lngC = 2 To lngLastRow
.Cells(lngC, 1).Copy .Cells(2, 8)
.Cells(lngC, 1).Copy .Cells(3, 9)
.Cells(lngC, 1).Copy .Cells(2, 18)
Call nachAuswahl_1
Next lngC
End With
Application.ScreenUpdating = True
MsgBox Timer - t & " sec", , "Makrolaufzeit" ' Zeitmessung
End Sub
Sub nachAuswahl_1()
Dim ID As Long
Dim letzteZeileA As Long
Dim suchErgebnis As Object
Dim wsA As Worksheet ' Blatt "Auswahl_1"
Dim wsB As Worksheet ' Blatt "BasisNeu"
Dim zeileA As Long
Dim zeileB As Long
Worksheets("Auswahl_1").Activate
Last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("Auswahl_1").Range("A5:W" & Last).ClearContents
Sheets("Auswahl_1").Range("X7:DD" & Last).ClearContents
' von BasisNeu nach Auswahl_1
Sheets("BasisNeu").Columns("A:W").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Kriterien").Range("=H1:N3"), CopyToRange:=Range("A4:W4") _
, Unique:=True
Sheets("Auswahl_1").Range("K3") = Sheets("Kriterien").Range("H2")
End Sub
Der sogenannte "AdvancedFilter" ist in der Schreibform -wie oben- anscheinend nicht in der Lage, zwischen
Freibut und FreiburgII
oder zB Dortmund und DortmundII zu unterscheiden.
Ich habe mal zum besseren Verständnis eine Mappe mit dem relevanten Problem hochgeladen:
https://www.herber.de/bbs/user/148257.xlsb
Auch zB diese Variante
For lngC = 2 To lngLastRow
.Cells(2, 8).Value = Cells(lngC, 1).Value
.Cells(3, 9) .Value = Cells(lngC, 1).Value
.Cells(2, 18) .Value = Cells(lngC, 1).Value
Kann mal bitte jemand drauf schauen und mir eine Lösung anbieten?!
Gruss
Fred