AW: Was soll das heißen?
12.09.2007 19:46:30
lisa
Hallo Wolli
Ich habe jetzt ein Change Ereignes als Zweites umbenannt.
Das erste läuft wie gehabt, aber die suche über c1 (zweites Change Ereignis) läuft nicht
Change Ereigniss Suche über a1 (vielen Dank an Renee) läuft wie gehabt, aber das zweite bekomme ich nicht an die Gänge!
Ich habe es noch mal beigefügt, vieleicht kann sich ja noch einmal jemand erbahmen.
Private Sub zweites_Worksheet_Change(ByVal Target As Range)
Dim intbereich, intergebnis, intgef As Integer
Dim loletzte As Long
If Target.Address "$C$1" Then Exit Sub
Application.EnableEvents = False
ActiveSheet.Range("e1:f1").ClearContents
intgef = 1
loletzte = IIf(IsEmpty(ActiveSheet.Range("d65536")), _
ActiveSheet.Range("d65536").End(xlUp).Row + 1, 65536)
If Target = "" Then Exit Sub
For intbereich = 4 To loletzte
If InStr(1, ActiveSheet.Cells(intbereich, 4), Target, vbTextCompare) Then
ActiveSheet.Cells(intgef, 5) = ActiveSheet.Cells(intbereich, 4)
intergebnis = intbereich
ActiveSheet.Rows(intbereich).Delete
ActiveSheet.Cells(intgef, 6) = intergebnis
intgef = intgef + 1
End If
Next intbereich
Application.EnableEvents = True
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Const iAnzahlSpalten = 1
Dim lRow As Long
Dim bFilterAktiv As Boolean
Cancel = True
If Target.Row > 1 Or Target.Column > iAnzahlSpalten Or _
Target.Cells.Count > 1 Then Exit Sub
bFilterAktiv = False
For lRow = 1 To iAnzahlSpalten
If Not IsEmpty(ActiveSheet.Cells(1, lRow)) Then bFilterAktiv = True
Next lRow
If Not (bFilterAktiv) Then
MsgBox "Kein Autofilter aktiv!", vbOKOnly + vbExclamation, "Kopieren"
Exit Sub
End If
Application.EnableEvents = False
lRow = Sheets("Tabelle2").Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row + 1
ActiveSheet.Range("3:" & ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row). _
Copy _
Destination:=Sheets("Tabelle2").Cells(lRow, 1)
Application.CutCopyMode = False
MsgBox "Gefilterte Daten wurden nach Tabelle2 kopiert!", vbOKOnly + vbInformation, " _
Kopieren"
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Const iAnzahlSpalten = 1
Dim ix As Integer
Dim af As Filter
If Target.Row > 1 Or _
Target.Column > iAnzahlSpalten Or _
Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
If ActiveSheet.AutoFilterMode Then ActiveSheet.Range("2:2").AutoFilter
For ix = 1 To iAnzahlSpalten
If Not (ActiveSheet.Cells(1, ix) = "") Then
If WorksheetFunction.IsNumber(ActiveSheet.Cells(3, ix)) Then
ActiveSheet.Cells(2, ix).AutoFilter Field:=ix, _
Criteria1:="=" & ActiveSheet.Cells(1, ix)
Else
ActiveSheet.Cells(2, ix).AutoFilter Field:=ix, _
Criteria1:="=*" & ActiveSheet.Cells(1, ix) & "*"
End If
End If
Next ix
If Not (ActiveSheet.AutoFilterMode) Then ActiveSheet.Range("2:2").AutoFilter
Application.EnableEvents = True
End Sub
Es ist mir wirklich schon unangenehm, aber ich schaffe es nicht allein
Liebe Grüße Lisa