Datenbank mit Excel VBA

Hallo zusammen,
ich bin gerade dabei eine Datenbank mit Excel VBA zu erstellen. Und zwar befinden sich in dieser Technologien die anhand von verschiedenen Kriterien bewertet worden. (aktuell sind es noch Dummy Files) Dem Anwender soll es ermöglicht werden anhand dieser Kriterien eine Suche durchzuführen, um die passende Technologie für seine Zwecke herauszufinden. Um dies zu erreichen, habe ich einen Suchbereich eingerichtet, in dem der Anwender nach den verschiedenen Kriterien suchen kann. Die eigentliche Suche möchte ich über einen "Advanced Filter" durchführen und habe deshalb einen Kriterienbereich eingerichtet. Der Kriterienbereich (P4= Überschrift; P5=Formel und soweiter für die anderen Kriterien bis W) und der Suchbereich sind mit einer =WENN(C4="";"*";C4) verlinkt und das für die anderen Kriterien geht dann entsprechend bis J. Nur wenn ich jetzt das Makro aufnehme und es ausführe um mit diesem (Das Makro schreibe ich unter den Text) die Daten zu filtern werden von 27 Datensätzen nur 1 angezeigt, obwohl kein Kriterium eingegeben ist "*". Ich habe schon alles versucht, was mit so eingefallen ist, jedoch hat nicht funktioniert. Also die Überschrift nicht von Hand eingegeben, sondern kopiert und so weiter. Was auch merkwürdig ist wenn ich die, WENN Formel bis auf eine entferne, werden alle Datensätze angezeigt ich kann dann leider nur nach einem Kriterium suchen. Ich hoffe, von Euch kann mir wer weiterhelfen oder einen neuen Ansatz aufzeigen, wie ich das Problem lösen kann.
Das ist das Makro:

Sub Filter()
' Filter Makro
'    Sheets("Daten").Range("B4:I77").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("P4:W5"), CopyToRange:=Range("C6:J6"), Unique:=False
End Sub

Und hier der Link zu der Excel-Datei:
https://www.herber.de/bbs/user/105258.xlsm
Schon mal vielen Dank für die Hilfe.
MFG
Ned Flanders

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Filterme() Dim c As Range With Sheets("Filter") .Range("P5:W5") = .Range("C4:J4").Value For Each c In .Range("P5:W5") If Not IsEmpty(c) Then c = "*" & c & "*" Next c Sheets("Daten").Range("B4:I77").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=.Range("P4:W5"), CopyToRange:=.Range("C6:J79"), Unique:=False End With End Sub

hi
Problem 1: Für Zahlen lassen sich keine Wildcards verwenden

Sub Filterme()
Dim c As Range
With Sheets("Filter")
.Range("P5:W5") = .Range("C4:J4").Value
For Each c In .Range("P5:W5")
If Not IsEmpty(c) And Not IsNumeric(c) Then c = "*" & c & "*"
Next c
Sheets("Daten").Range("B4:I77000").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("P4:W5"), CopyToRange:=.Range("C6:J79000"), Unique:=False
End With
End Sub

Problem 2:
https://www.herber.de/bbs/user/105333.xlsm

Sub Filterme()
Dim c As Range
With Sheets("Filter")
Call CopyText(.Range("G4"), .Range("U5"))
Call CopyText(.Range("H4"), .Range("V5"))
Call CopyZahl(.Range("F4"), .Range("S5"))
Call CopyZahl(.Range("I4"), .Range("V5"))
Call CopyZahl(.Range("J4"), .Range("Y5"))
Sheets("Daten").Range("B4:I77000").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("P4:Z5"), CopyToRange:=.Range("C6:J79000"), Unique:=False
End With
End Sub

Private Sub CopyText(rng1 As Range, rng2 As Range)
If IsEmpty(rng1) Then
rng2 = ""
Else
rng2 = "*" & rng1 & "*"
End If
End Sub

Private Sub CopyZahl(rng1 As Range, rng2 As Range)
Const Toleranz As Currency = 0.1  ' hier einstellen 0.1 = 10 % plus/minus
If IsEmpty(rng1) Then
rng2 = ""
rng2.Offset(0, 1) = ""
Else
rng2 = ">" & rng1 * (1 - Toleranz)
rng2.Offset(0, 1) = "

Allerdings frage ich mich jetzt langsam schon, was die die Aktion mit dem erweiterten Filter soll. Es handelt sich m.E. um stink normale Filterkriterien und du baust hier den Autofilter nach.
cu
Chris

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Datenbank mit Excel VBA

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread