' **********************************************************************
' Modul: Tabelle3 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Private Sub CommandButton2_Click()
Dim rng As Range, rngF As Range, rngRet As Range
Dim lngIndex As Long, lngRows() As Long
Dim strFirst As String
On Error GoTo ErrExit
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
Redim lngRows(0)
If Range("C5") <> "" Then
Range("A15").CurrentRegion.Offset(1, 0).Clear
With Sheets("Archiv")
If CheckBox1 Then Set rngF = .Columns(1)
If CheckBox2 Then
If rngF Is Nothing Then
Set rngF = .Columns(2)
Else
Set rngF = Union(rngF, .Columns(2))
End If
End If
If CheckBox3 Then
If rngF Is Nothing Then
Set rngF = .Columns(3)
Else
Set rngF = Union(rngF, .Columns(3))
End If
End If
Set rng = rngF.Find(Me.Range("C5"), LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
If Not rng Is Nothing Then
strFirst = rng.Address
Do
If IsError(Application.Match(rng.Row, lngRows, 0)) Then
Redim Preserve lngRows(lngIndex)
lngRows(lngIndex) = rng.Row
lngIndex = lngIndex + 1
If rngRet Is Nothing Then
Set rngRet = .Range(.Cells(rng.Row, 1), .Cells(rng.Row, 3))
Else
Set rngRet = Union(rngRet, .Range(.Cells(rng.Row, 1), .Cells(rng.Row, 3)))
End If
End If
Set rng = rngF.FindNext(rng)
Loop While Not rng Is Nothing And strFirst <> rng.Address
End If
End With
If Not rngRet Is Nothing Then
rngRet.Copy Me.Range("B16")
With Me.Range("A16").Resize(lngIndex, 1)
.Formula = "=ROW(A1)"
.Value = .Value
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
End If
End If
ErrExit:
With Err
If .Number <> 0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "Sub 'CommandButton2_Click'" & vbLf & String(40, "=") & vbLf & vbLf & _
IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & "Fehlernummer:" & vbTab & _
.Number & vbLf & vbLf & "Beschreibung:" & vbTab & .Description & vbLf, vbExclamation, "Fehler in Modul - Tabelle3"
.Clear
End If
End With
On Error GoTo 0
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.DisplayAlerts = True
End With
Set rng = Nothing
Set rngF = Nothing
Set rngRet = Nothing
End Sub