kleine Makro-Anpassung
David
beim Klick auf eine Schaltfläche wird das untenstehende Makro ausgeführt. Dabei wird die Tabelle "all_data_neu" bearbeitet. Jetzt soll einfach in das Makro eine weitere Tabelle "all_data_alt" hinzugefügt werden, sodass das gleiche Makro das auf die Tabelle "all_data_neu" ausgeführt wird auch in der Tabelle "all_data_alt" durchgeführt wird. Wahrscheinl. muss irgendwo nur ein kleiner Befehl eingebaut werden, aber ich bekomme es nicht heraus. Ich nehme in dem Teil, den ich im Code fett geschrieben habe, muss noch etwas hinzugefügt werden?!
Private Sub CommandButton1_Click()
Dim rng As Range, rngLoeschen As Range, StatusCalc As Long
Dim objWs As Worksheet, lngJ As Long, objWsAll As Worksheet
Dim arrWerteMaster() As String, lngIndex As Long, Spalte As Long, bLoeschen As Boolean
If Me.ComboBox1.ListIndex > -1 Then
Set rng = Sheets("Master").Range("Liste").Find(Me.ComboBox1.Text, lookat:=xlWhole)
If Not rng Is Nothing Then
If rng.Offset(0, 1) = Me.TextBox1.Text Then
intC = 0
If rng.Offset(0, 2) "" Then
'Alle Blätter außer Übersicht ausblenden
For Each objWs In Me.Parent.Worksheets
If objWs.Name "Übersicht" Then objWs.Visible = xlSheetVeryHidden
Next
'Blätter mit Zugriff für Name einblenden
For lngJ = 2 To 12
With rng.Offset(0, lngJ)
If .Text "" Then
With Sheets(.Text)
.Visible = xlSheetVisible
.Activate
End With
End If
End With
Next
Set objWsAll = Worksheets("all_data_neu")
'Vergleichswerte aus Blatt Master einlesen
ReDim arrWerteMaster(13 To 16)
For lngIndex = 13 To 16
arrWerteMaster(lngIndex) = rng.Offset(0, lngIndex).Text
Next
With objWsAll
With Application
StatusCalc = .Calculation
If StatusCalc xlCalculationManual Then .Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
.StatusBar = "Tabelle ""all_data_neu"" wird aufbereitet"
End With
'Spaltenwerte mit Werten aus Master vergleichen
'Wenn ein Wert übereinstimmt dann wird die Zeile nicht gelöscht
For lngJ = .Cells.SpecialCells(xlCellTypeLastCell).Row To 2 Step -1
bLoeschen = True
For lngIndex = LBound(arrWerteMaster) To UBound(arrWerteMaster)
If arrWerteMaster(lngIndex) "" Then
For Spalte = 1 To 40
Select Case Spalte
Case 29, 30, 32, 33, 34 'Spalten AC,AD, AF, AG und AH
If .Cells(lngJ, Spalte).Text = arrWerteMaster(lngIndex) Then
bLoeschen = False
Exit For
End If
End Select
Next
If bLoeschen = False Then Exit For
End If
Next
If bLoeschen = True Then
If rngLoeschen Is Nothing Then
Set rngLoeschen = .Cells(lngJ, 1)
Else
Set rngLoeschen = Application.Union(rngLoeschen, .Cells(lngJ, 1))
End If
End If
Next
If Not rngLoeschen Is Nothing Then
rngLoeschen.EntireRow.Delete
End If
With Application
If StatusCalc .Calculation Then .Calculation = StatusCalc
.ScreenUpdating = False
.EnableEvents = True
.StatusBar = False
End With
End With
Else
For Each objWs In Me.Parent.Worksheets
objWs.Visible = xlSheetVisible
Next
End If
Else
intC = intC + 1
If intC Danke!!!
Grüße,
David