Problem mit der Suchfunktion
22.07.2014 10:25:42
Jenny
bitte helft mir. Wenn ich Excel starte, kann ich die Suchfunktion ganz normal nutzen. Wenn ich jedoch unten stehendes Makro ausführe und dann die Suchfunktion nutzen möchte, ist plötzlich der Haken "Gesamten Zelleninhalt vergleichen" gesetzt, was er vorher nicht war. Diesen Haken brauche ich äußerst selten, dafür benutze ich aber das Makro sehr oft. Es ist lästig 5mal am Tag diesen Haken wieder zu entfernen oder alles zu speichern und Excel neu zu starten, vor allem da der Haken dann in allen Arbeitsmappen gesetzt ist, nicht nur in der in der das Makro ausgeführt wurde. Weiß da jemand von euch Rat?
LG und danke
Jenny
Sub Makro4()
' Makro4 Makro
' Tastenkombination: Strg+q
Dim wks As Worksheet, Zelle As Range
Dim Zeile As Long, Zeile_L As Long, Zeile_LF As Long, varSuch
Set wks = ActiveSheet
With wks
'letzte Zeile mit Daten
Set Zelle = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByRows, Searchdirection:=xlPrevious)
If Zelle Is Nothing Then
'Tabellenblatt ist leer
MsgBox "keine Daten im Tabellenblatt"
GoTo Beenden
Else
Zeile_L = Zelle.Row
With .Range(.Cells(1, 1), .Cells(Zeile_L, 16)) 'Daten Spalten A bis P
With .Font
.Name = "Calibri"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
.Font.Bold = False
End With
'letzte Zeile in Spalte F
Zeile_LF = .Cells(.Rows.Count, 6).End(xlUp).Row
Application.ScreenUpdating = False
'Wert in Spalte A merken
varSuch = .Cells(Zeile_LF, 1).Value
'Werte mit Werte in Spalte A vergleichen und ggf. löschen
For Zeile = Zeile_L To Zeile_LF + 1 Step -1
If .Cells(Zeile, 1).Value = varSuch Then
.Rows(Zeile).Delete Shift:=xlShiftUp
End If
Next
If Zeile_L > 2 Then 'wenn Zeile1 = Spaltentitel sonst > 1 prüfen
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range(.Cells(1, 3), .Cells(Zeile_L, 3)), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=.Range(.Cells(1, 6), .Cells(Zeile_L, 6)), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With .Sort
.SetRange wks.Range(wks.Cells(1, 1), wks.Cells(Zelle.Row, 16))
.Header = xlYes 'xlGuess - wenn Spaltentitel in Zeile 1 dann unbedingt xlYes sonst _
_
xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.ScreenUpdating = True
End If
End If
End With
Beenden:
End Sub