Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1192to1196
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Zellen vergleichen und löschen (Makro)
David
Hallo,
ich habe im Forum bisschen gestöbert und den Beitrag "Tabelle via Passwort freigeben" gefunden! Genau sowas habe ich auch gesucht.
Ich habe das ganze auch schon ein wenig angepasst. https://www.herber.de/bbs/user/73065.xls
Aber jetzt habe ich noch folgende Fragen:
1. Ich habe in der Tabelle "Master" jetzt insgesamt 5 Zugriffe. Wenn in allen Zellen eines Mitarbeiters eine Tabelle eingetragen ist funktioniert alles soweit gut. Wenn die Zelle eines Zugriffs aber leer bleibt erhalte ich einen Laufzeitfehler. Wie kann ich das umgehen?
2. 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.
Könnt ihr mir hier helfen?
Beste Grüße,
David

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Zellen vergleichen und löschen (Makro)
15.01.2011 16:26:39
fcs
Hallo David,
hier die angepasste Prozedur für den OK-Button.
Gruß
Franz
Private Sub CommandButton1_Click()
Dim rng As Range
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
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
.Rows(lngJ).Delete shift:=xlShiftUp
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
.Rows(lngJ).Delete shift:=xlShiftUp
End If
Next
End If
End With
Else
For Each objWs In Me.Parent.Worksheets
objWs.Visible = xlSheetVisible
Next
End If
Else
intC = intC + 1
If intC 

Anzeige
AW: Zellen vergleichen und löschen (Makro)
17.01.2011 13:31:11
David
Hi Franz,
danke für Deine Antwort. Hab es mit der Datei getestet und funktioniert prima! Echt gut!
Aber es gibt noch eine Herausforderung.
Die Originaldatei hat im Tabellenblatt "all_data" knapp 6.000 Datensätze. Die Berechungen dauern sehr lange. Ich weiß nicht genau wie lange, weil ich bei 8 min die Berechnungen abgebrochen habe. Wie kann man das umgehen? Ich nehme an, dass liegt am Löschen der Datensätze. Gibt es eine Alternative zum Löschen? Statt Löschen z.B. in ein neues Tabellenblatt verschieben?
Danke nochmal für Deine Hilfe.
Beste Grüße,
David
AW: Zellen vergleichen und löschen (Makro)
17.01.2011 20:13:53
fcs
Hallo David,
ich hab die Prozedur nochmals angepasst.
Die zu löschenden Zeilen werden zunächst in eine Range-Variablen gesammelt und dann in einer Aktion gelöscht.
Zusätzlich werden während der Löschaktionen die Bildschirmaktualisierung und Ereignismakros deaktiviert und der Berechnungsmodus auf Manuell gesetzt, um die Makroausführung zu beschleunigen.
Die Rechenzeit sollte jetzt bei einem einigermaßen flotten Rechner bei unter einer Minute sein.
Gruß
Franz
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 

Anzeige
AW: Zellen vergleichen und löschen (Makro)
19.01.2011 13:41:05
David
Hi Franz,
das klappt perfekt!!! Vielen Dank für Deine Hilfe! Wie soll ich mich revangieren?:-)
Beste Grüße,
David

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige