Makro Erweiterung
David
ich bräuchte eine kleine Erweiterung für mein Makro.
So funktioniert das Makro im Moment:
In der Tabelle "Master" sind in der Spalte H und I Einträge. In der Spalte H stehen teilweise nochmal die Namen der Benutzer die sich angemeldet haben. Nachdem sich der Benutzer angemeldet hat soll überprüft werden, ob in Spalte H sein Name steht (Info: Entweder steht sein Name da oder nichts).
- Falls ja, dann soll der Name mit der Spalte AF und AC der Tabelle "all_data" verglichen werden. Bei Ungleichheit soll der Datensatz gelöscht werden.
- Falls nein, dann soll Spalte I aus "Master" mit der Spalte AG aus "all_data" verglichen werden. Bei Ungleichheit soll der Datensatz gelöscht werden.
Ergänzung/Erweiterung:
Und zwar soll die Spalte J aus "Master" mit der Spalte AH aus der Tabelle "all_data" verglichen werden. Falls die Werte unterschiedlich sind dann löschen (wie bei den anderen auch).
Das ist der aktuelle Code in dem die Erweiterung eingefügt werden soll:
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 sSpalteH As String, sSpalteI As String
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 6
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")
sSpalteH = rng.Offset(0, 7).Text
sSpalteI = rng.Offset(0, 8).Text
With objWsAll
With Application
StatusCalc = .Calculation
If StatusCalc xlCalculationManual Then .Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
.StatusBar = "Tabelle ""all_data"" wird aufbereitet"
End With
If sSpalteH = rng.Text Then
'Spalten AC und AF mit Wert in Spalte H vergleichen
For lngJ = Application.WorksheetFunction.Max( _
.Cells(.Rows.Count, 29).End(xlUp).Row, _
.Cells(.Rows.Count, 32).End(xlUp).Row) To 2 Step -1
If .Cells(lngJ, 29).Text = sSpalteH Or .Cells(lngJ, 32).Text = sSpalteH Then
'do nothing
Else
If rngLoeschen Is Nothing Then
Set rngLoeschen = .Cells(lngJ, 1)
Else
Set rngLoeschen = Application.Union(rngLoeschen, .Cells(lngJ, 1))
End If
End If
Next
Else
'Spalten AG mit Wert in Spalte I vergleichen
For lngJ = .Cells(.Rows.Count, 33).End(xlUp).Row To 2 Step -1
If .Cells(lngJ, 33).Text = sSpalteI Then
'do nothing
Else
If rngLoeschen Is Nothing Then
Set rngLoeschen = .Cells(lngJ, 1)
Else
Set rngLoeschen = Application.Union(rngLoeschen, .Cells(lngJ, 1))
End If
End If
Next
End If
If Not rngLoeschen Is Nothing Then
rngLoeschen.EntireRow.Delete
End If
With Application
If StatusCalc .Calculation Then .Calculation = StatusCalc
.ScreenUpdating = False
.EnableEvents = False
.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!
Beste Grüße,
David