VBA Filter entfenen

Private Sub Worksheet_Change(ByVal Target As Range) Dim bn As String, wert As String Dim lz As Long Dim Blatt As Worksheet If Target.Address = "$B$8" Or Target.Address = "$B$10" Then Range("B12").Calculate bn = Range("B8").Text On Error Resume Next Set Blatt = Worksheets(bn) On Error GoTo 0 If Blatt Is Nothing Then Exit Sub lz = Sheets(bn).Cells(Rows.Count, 1).End(xlUp).Row wert = Range("B12").Text If WorksheetFunction.CountIf(Sheets(bn).Columns(5), wert) = 0 Then Range("A11").Value = "Abteilung nicht gefunden!" MsgBox "Noch keine Daten f?r dieses Jahr vorhanden! Bitte nicht vergessen mit F9 _ _ _ neu zu berechnen, dies kann einige Zeit in Anspruch nehmen!" Exit Sub Else MsgBox "Bitte nicht vergessen mit Taste F9 neu zu berechnen,dies kann einige Zeit _ _ _ in Anspruch nehmen!" Range("A11").Value = "" End If If Sheets(bn).ProtectContents = True Then Sheets(bn).Unprotect Password:="*******" If Sheets(bn).FilterMode Then Sheets(bn).ShowAllData Sheets(bn).Range("A8:AL" & lz).AutoFilter Field:=5, Criteria1:=wert Sheets(bn).Rows(9).Hidden = True Sheets(bn).Protect Password:="******", UserInterfaceOnly:=True, AllowFiltering:= _ True End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Michael,
(heissen heute alle Fragenden Michael? ;-)
vielleicht so?

Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Address
Case "$B$8", "$B$10"
B8_oder_B10_behandeln
Case "$B$12"
B12_behandeln Target
Case Else
SonstigeRange_behandeln
End Select
End Sub
Private Sub B8_oder_B10_behandeln()
Dim BN As Worksheets
Range("B12").Calculate
If Blatt_existiert(Range("B8").Text) Then
Set BN = Worksheets(Range("B8").Text)
If WorksheetFunction.CountIf(BN.Columns(5), Range("B12").Text) = 0 Then
Range("A11").Value = "Abteilung nicht gefunden!"
Neu_berechnen "Noch keine Daten für dieses Jahr vorhanden!"
Else
Range("A11").Value = ""
Neu_berechnen
End If
If BN.ProtectContents Then BN.Unprotect Password:="*******"
If BN.FilterMode Then Sheets(BN).ShowAllData
BN.Range("A8:AL" & lz).AutoFilter Field:=5, Criteria1:=wert
BN.Rows(9).Hidden = True
BN.Protect Password:="******", UserInterfaceOnly:=True, AllowFiltering:=True
End If
End Sub
Private Sub B12_behandeln(ByVal Target As Range)
If Target.Value = 10 Then
ActiveSheet.ShowAllData
End If
End Sub
Private Sub SonstigeRange_behandeln()
'zurZeit nichts
End Sub
Private Sub Neu_berechnen(Optional Zusatztext = "")
If Zusatztext  "" Then Zusatztext = Zusatztext & vbCr
If MsgBox(Zusatztext _
& "Bitte nicht vergessen mit F9 neu zu berechnen, " & vbCr _
& "dies kann einige Zeit in Anspruch nehmen!" & vbCr & vbCr _
& "Jetzt neuberechnen?", vbOKCancel) = vbOK Then Application.Calculate
End Sub
Private Function Blatt_existiert(BlattName) As Boolean
'Gibt by Fehler False raus, sonst True
On Error Resume Next
Blatt_existiert = Not (ThisWorkbook.Worksheets(BlattName) Is Nothing)
End Function

Viel Erfolg
Yal

Hallo Michael,
ich habe für meine ersten Geh-Versuche in VBA weit mehr als 3 Tage gebraucht.
Schneide den Elefant in Scheiben. Löse kleine Aufgaben, bis sie funktionieren und lerne dabei, was geht und was nicht. Den grossen Wurf beim ersten Versuch? Manche sind genial (dann hättest Du mein ersten Code zum laufen hinbekommen) Mit einem Code irgendwo aus dem Net? Bei der Umfang niemals.
Das Problem von anderen lösen lassen: wie gesagt, punktuelle Hilfe ja, Aufgaben übernehmen, nein. Dafür gibt es Auftragsprogrammierung (oben rechts).
Die Referenz-Bücher (eins davon muss man haben):
"VBA mit Excel" von Bernd Held Rheinwerk-Verlag oder
"Excel 2016 programmieren" von Michael Kofler.
(Ich hatte den Kofler für Excel 7)
VG
Yal

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread