|
Hallo,
ich bin noch recht unerfahren in der VBA - Programmierung. Deshalb brauche ich dringend Hilfe.
Ich möchte für mich ein Programm mit VBA, mit dem ich die Spalten BO, BP, CT,CQ, CR und CU nach den Kriterien: damage, mechanical, bracket, connector und housing filtern kann, programmieren.Es sind von Spalte A bis HH alle Spalten befüllt. Das Programm soll zuerst die Spalte Bo filtern, dann die gefilterten Daten markieren und in eine neue Tabelle kopieren. Danach soll der Filter in der gefilterten Tabelle gelöscht werden. Jetzt soll das Programm nach dem gleichen Muster mit den anderen Spalten verfahren. Die Filterkriterien können sich mit der Zeit aber erweitern und stehen in der Tabelle 2 in der Spalte A von Zelle A2.
Unten mein Code für die erste Spalte:
Option Explicit
Sub Tabelle_Filtern()
Dim lngZeileMax As Long
Dim tblA As Worksheet
Dim arrCriteria() As String
Dim lngCriteriaCount As Long
Dim rngFilterRange As Range
Dim lngFilterRow As Long, lngFilterColumn As Long
Dim lngFilter As Long
Dim loLetzte As Long
Worksheets("filter_criteria")
loLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
Worksheets("Raw_Data_with_8D")
Set tblA = Raw_Datas_with_8D
Application.ScreenUpdating = False
With tbl_Daten
lngCriteriaCount = loLetzte
ReDim arrCriteria(0 To lngCriteriaCount - 1)
arrCriteria(0) = "mechanical"
arrCriteria(1) = "damage"
arrCriteria(2) = "connector"
arrCriteria(3) = "housing"
arrCriteria(4) = "bracket"
rngFilterRange.AutoFilter Field:=67, _
Criteria1:=arrCriteria(), _
Operator:=xlFilterValues
With Worksheets(“Raw_Datas_with_8D")
If .AutoFilterMode Then
If .FilterMode Then
With .AutoFilter
lngFilterRow = .Range.Row
lngFilterColumn = .Range.Column
With .Filters
For lngFilter = 1 To .Count
If .Item(lngFilter).On Then Exit For
Next
End With
End With
.Range(.Range(.Cells(lngFilterRow + 1, lngFilterColumn), _
.Cells(lngFilterRow + 1, _
lngFilterColumn + .AutoFilter.Filters.Count - 1)), _
.Cells(lngFilterRow, lngFilter).End(xlDown)).Copy _
Worksheets("duplicates_deleted").Range("A1")
Else
MsgBox "Der Autofilter ist nicht gesetzt.", 48, "Hinweis"
End If
Else
MsgBox "Kein Autofilter in der Tabelle.", 48, "Hinweis"
End If
End With
With Worksheets("Raw_Datas_with_8D")
If .AutoFilterMode Then
If .FilterMode Then
.ShowAllData
End If
End If
End With
Könnte man das auch mit einer Schleife lösen?
Über Hilfe würde ich mich sehr freuen. Im Voraus vielen Dank.
Viele Grüße, Dominik Mauer.
|