Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
828to832
828to832
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Zahlen vergleichen

Forumthread: Zahlen vergleichen

Zahlen vergleichen
14.12.2006 13:02:46
Walter
Hallo,
habe folgendes Problem:
möchte die Daten aus der Spalte "C" ab c5 (Tabelle1) mit der Spalte "C" ab c5
der (Tabell3) vergleichen.
Wenn der Wert aus der Tabelle 1 nicht in der Tabelle 3 vorhanden ist,
soll die Zeile c bis H der Tabelle 1 gelöscht werden.
Übrings Ende der Spalte C kann mal 100 mal 500 Zeilen sein.
Habe mal dies in der Recherche gefunden, komm damit allerdings nicht klar:

Private Sub CommandButton1_Click()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim iZeile As Long, LetzteZeile As Long
Set WS1 = ThisWorkbook.ActiveSheet  'entspricht daten1.xls
Set WS2 = Workbooks("Mappe2.xls").Worksheets("Tabelle1") 'entspricht daten2.xls
LetzteZeile = WS1.Range("A65536").End(xlUp).Row
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
For iZeile = LetzteZeile To 1 Step -1
If WorksheetFunction.CountIf(WS2.Columns("A:A"), WS1.Cells(iZeile, 1)) > 0 Then Rows(iZeile).EntireRow.Delete
Next iZeile
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Gruß WALTER
Anzeige

19
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Bitte dringend, hier noch
14.12.2006 15:18:07
WalterB
Hallo,
suche jetzt seit 3h in der Recherche, habe zwar gerade wieder ein Makro gefunden, kann
aber leider nicht anpassen. 

Sub suchen()
If MsgBox("daten übertragen ? ", vbInformation + vbYesNo) = 7 Then Exit Sub
Dim LoLetzte As Long
With Worksheets("Arbs")
If Application.WorksheetFunction.CountIf(.Range("A6:A" & .Range("B65536").End(xlUp).Row), Worksheets("Reps").Range("A6")) > 0 Then
MsgBox "Eintrag bereits vorhanden."
Exit Sub
Mein Problem noch einmal:
möchte die Daten aus der Spalte "C" (stehen Nr. drin) ab c5 (Tabelle1) mit der (Tabell3)Spalte "C" ab c5
vergleichen.
Wenn der Wert aus der Tabelle 1 NICHT in der Tabelle 3 vorhanden ist,
soll die Zeile c bis H der "Tabelle 1" gelöscht werden.
Übrings Ende der Spalte C kann mal 100 mal 500 Zeilen sein.
mfg walterB
End If
LoLetzte = wa.Range("b65536").End(xlUp).Row + 1
.Cells(LoLetzte, 1) = Worksheets("Rebs").Range("h11")
.Cells(LoLetzte, 2) = Worksheets("Rebs").Range("h10")
Sheets("Arbs").Select
If MsgBox("Daten archiviert!", vbInformation + vbYesNo, "OFFICECONTROL") = 6 Then
Sheets("tab1").Select
End If
End With
End Sub

Anzeige
AW: Zahlen vergleichen
14.12.2006 15:45:18
fcs
Hallo Walter,
habe die Prozedur mal auf deine Wünsche hin umgestrickt.
Gruss
Franz

Private Sub CommandButton1_Click()
Dim WS1 As Worksheet, WS2 As Worksheet, BereichTab3 As Range
Dim iZeile As Long, LetzteZeile As Long
Set WS1 = ThisWorkbook.ActiveSheet  'Tabelle mit dem Button1
Set WS2 = ThisWorkbook.Worksheets("Tabelle3")
Set BereichTab3 = WS2.Range(WS2.Cells(5, "C"), WS2.Cells(WS2.Rows.Count, "C").End(xlUp))
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
With WS1
LetzteZeile = .Cells(.Rows.Count, "C").End(xlUp).Row 'Letzte Zeile in Spalte C Tabelle 1
For iZeile = LetzteZeile To 5 Step -1
If Application.WorksheetFunction.CountIf(BereichTab3, .Cells(iZeile, "C").Value) = 0 Then
.Range(.Cells(iZeile, "C"), .Cells(iZeile, "H")).Delete Shift:=xlShiftUp
End If
Next iZeile
End With
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Anzeige
Super aber noch
14.12.2006 16:22:01
Walter
Hallo Franz,
Super es fubnktioniert.
Habe gerade gemerkt das ich noch die Daten der Sheet Tabelle4 (Bestand) abprüfen muß, da die Daten jetzt verloren gegeangen sind.
Mein Fehler.
Kann man dies irgenwie hintereinander durchführen oder muß ich erst die Daten in eine
Tabelle zusammen kopieren ?
mfg walter
Anzeige
AW: Super aber noch
14.12.2006 19:17:33
fcs
Hallo Walter,
das kann man in einer Prozedur abarbeiten.
In welcher Reihenfolge sollen die Tabellen verglichen werden?
Welche Tabellen sollen jeweils mit einander verglichen werden?
In welcher Tabelle sollen ggf. die Zellen gelöscht werden?
Gruss
Franz
Ja aber
14.12.2006 20:00:58
Walter
Hallo FRanz,
das wäre natürlich Super.
Die Daten dürfen auf keinen Fall in die "Tabelle1" kopiert werden, da liegt das Button, von da aus werden die Daten mit der "Tabelle3" abgeglichen und es müßte noch die
"Tabelle4" geprüft werden.
Das Problem allerdings !!! ES werden vielleicht Daten in der Tabelle1 gelöscht, die NIcht in der Tabelle3 sind aber NOCH in der Tabelle4, so das eine Löschung Falsch ist.
Ich habe kein Problem damit die Daten in eine Tabelle z.b.Tabelle5 zu kopieren und eine wird halt geprüft ODER ?
Da ich kein Frick bin kannst Du mir mal Schreiben was so passiert ?
mfg Walter
Anzeige
AW: Ja aber
14.12.2006 20:42:37
fcs
Hallo Walter,
ich hab die gemeinsame Prüfung der Tabelle1 mit den Tabellen 3 und 4 eingebaut. Namen der Tabellen im Makro ggf. noch anpassen. Zellen werden gelöscht, wenn Eintrag in Spalte C weder in Tabelle3 noch in Tabelle4 enthalten ist.
Gruss
Franz

Private Sub CommandButton1_Click()
Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet, BereichTab4 As Range, BereichTab3 As Range
Dim iZeile As Long, LetzteZeile As Long
Set WS1 = ThisWorkbook.ActiveSheet  'Tabelle mit dem Button1
Set WS2 = ThisWorkbook.Worksheets("Tabelle3")
Set WS3 = ThisWorkbook.Worksheets("Tabelle4")
Set BereichTab3 = WS2.Range(WS2.Cells(5, "C"), WS2.Cells(WS2.Rows.Count, "C").End(xlUp))
Set BereichTab4 = WS3.Range(WS3.Cells(5, "C"), WS3.Cells(WS3.Rows.Count, "C").End(xlUp))
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
With WS1
LetzteZeile = .Cells(.Rows.Count, "C").End(xlUp).Row 'Letzte Zeile in Spalte C Tabelle 1
For iZeile = LetzteZeile To 5 Step -1
If Application.WorksheetFunction.CountIf(BereichTab3, .Cells(iZeile, "C").Value) + _
Application.WorksheetFunction.CountIf(BereichTab4, .Cells(iZeile, "C").Value) = 0 Then
.Range(.Cells(iZeile, "C"), .Cells(iZeile, "H")).Delete Shift:=xlShiftUp
End If
Next iZeile
End With
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Anzeige
Danke aber die Frage
14.12.2006 20:57:30
Walter
Hallo Franz,
Danke.
Aber die Frage noch ?
Werden die Daten in die Tabelle1 kopiert ? (dürfen nicht da in den Spalten ab K noch Texte stehen)
Ist es viel Aufwand mir das kurz dahinter zu beschreiben was passiert, möchte gern
lernen, wenn zuviel Arbeit, dann lassen,
herzlichen Dank
mfg walter
Anzeige
AW: Danke aber die Frage
14.12.2006 22:41:40
fcs
Hallo Walter,
nein, es werden keine Daten in die Tabelle1 kopiert. Der Zellinhalt in Spalte C der Tabelle 1 wird jewils in einem Rutsch mit den Inhalten der Spalte C in den TAbellen 2 und 4 abgeglichen
Gruss
Franz

Private Sub CommandButton1_Click()
Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet, BereichTab4 As Range, BereichTab3 As Range
Dim iZeile As Long, LetzteZeile As Long
'Variablen für Tabellen die entsprechenden Tabellen zuweisen
Set WS1 = ThisWorkbook.ActiveSheet  'Tabelle mit dem Button1
Set WS2 = ThisWorkbook.Worksheets("Tabelle3")
Set WS3 = ThisWorkbook.Worksheets("Tabelle4")
'Bereich festlegen mit den Werten in Tabelle 3, die mit den Werten in Tabelle 1 verglichen werden sollen
Set BereichTab3 = WS2.Range(WS2.Cells(5, "C"), WS2.Cells(WS2.Rows.Count, "C").End(xlUp))
'Bereich festlegen mit den Werten in Tabelle 4, die mit den Werten in Tabelle 1 verglichen werden sollen
Set BereichTab4 = WS3.Range(WS3.Cells(5, "C"), WS3.Cells(WS3.Rows.Count, "C").End(xlUp))
'Automatische Berechnung und Ereignismakros deaktivieren, insbesondere dann erforderlich, wenn _
die Tabellen umfangreiche Berechnungen automatisch auf Zellwertänderungen _
reagierende Makros enthalten.
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
With WS1
'Ermitteln der letzten Zeile in Spalte C, die noch Werte emthält
LetzteZeile = .Cells(.Rows.Count, "C").End(xlUp).Row
'Zellen in Tabelle 1 Spalte C von der Letzten bis zue 5. Zeile mit den Werten in den _
anderen Tabellen vergleichen
For iZeile = LetzteZeile To 5 Step -1
' In der If-Bedingung wird gezählt, wie oft der Begriff in der Zelle in Tabelle 1 in den _
beiden Bereichen in Tabelle 3 und 4 vorkommt. Bei 0 wird in Tabelle 1 der Zellbereich gelöscht
If Application.WorksheetFunction.CountIf(BereichTab3, .Cells(iZeile, "C").Value) + _
Application.WorksheetFunction.CountIf(BereichTab4, .Cells(iZeile, "C").Value) = 0 Then
.Range(.Cells(iZeile, "C"), .Cells(iZeile, "H")).Delete Shift:=xlShiftUp
End If
Next iZeile
End With
'Berechnung wieder auf  Automatisch  stellen und die Ereignismakros wieder aktivieren
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Anzeige
Leider noch
15.12.2006 10:42:56
Walter
Guten Morgen Franz,
leider fehlen bei mir 20 Zeilen, werde jetzt abgleichen und Dich informieren.
Ansonsten gibt es keine Beanstanstandungen meinerseits, Makro läuft.
Super gemacht...
bis später Walter
Prima ... und zu
15.12.2006 11:46:25
zu
Du scheinst nicht unbedingt zu den Top 1000 der Forumsintelligenz zu gehören
Anzeige
Hallo Franz habe -)
15.12.2006 18:44:20
Walter
Hallo Franz,
bin gerade nach Hause gekommen, läuft bestens alles i.o.
herzlichen Dank für Deine Unterstützung.
Was meinst Du mit " Forumsintelligenz " , ich kenn vielleicht nicht die Gepflogenheiten,
wie man antworten soll oder beenden, na ja, bin ja noch "Lernfähig"
mfg Walter
Anzeige
AW: Forumsintelligenz
16.12.2006 08:49:26
fcs
Hallo Walter,
das "Top 1000 der Forumsintelligenz" ist nicht von mir drauf hat Herr oder Frau Zu den Gebrauchsmuster-Schutz.
Aber es schadet natürlich nicht, wenn man sich ein klein wenig mit den Geflogenheiten und Vorgehnsweisen im Forum vertraut macht indem man sich mal unter dem Punkt "Forums-Seiten" umsieht.
Gruss
Franz
Anzeige
Verarschen will ich ...
15.12.2006 07:21:38
Walter
Guten Morgen,
ich will Duich nicht verarschen !!!!!!!!!!!!!!!!
Es wurd doch geschlossen, daher hatte ich gedacht, ich darf mich nicht mehr melden !!!
Melde mich gleich, bin dann in der Firma !!!!!!!!!!!
mfg walter
Prima ... und zu ...
15.12.2006 07:37:02
zu
mein Gott Walter,
wenn du eine Frage zu Excel hast dann offen !
Wenn du nachdenken, dich melden oder was auch immer willst dann eben NICHT offen !
Es soll ja hier tatsächlich Leute geben die suchen sich gezielt offene Fragen um diese zu beantworten und nicht um deine wunderschöne Prosa zu lesen.
Ist das denn wirklich so schwer zu verstehen ?
Anzeige
Hallo habe doch Problem, hier mein Makro
15.12.2006 12:39:54
Walter
Hallo,
habe jetzt mal rumgetestet, leider komme ich nicht zu meinem Ergenis.
Das folgenden Makro funktioniert, es wird in der Sheet erstellt und die Sheet ist dann
eine xls Datei. Meine Ursprungsdatei wo diese Sheet drin war /ist heißt:
"Werkstatt.xls" , dies Datei ist noch aktiviert und ich könnte jetzt von dieser aus
ein Makro starten und in der Neu erstellten Mappe.xls diese reinkopieren.
Irgenwie ans Ende setzen ?
Nochmals Entschuldigung, wenn ich mich jetzt erst gemeldet habe, bin etwas im Streß, muß
und möchte das aber jetzt zu Ende bringen.
Hier mein Makro auch mit MIthilfe Forum erhalten und teilweise ergänzt, wie gesagt es funktioniert:
'------------ Datei erstellen -----------------------------------------

Private Sub CommandButton1_Click()
Dim strPath As String
Dim strPathCe As String
Dim objSh As Worksheet
Dim objWb As Workbook
Dim blnExist As Boolean, blnClose As Boolean
Dim OrdNam1 As String
Dim OrdNam2 As String
Dim OrdNam3 As String
Dim OrdNam4 As String
Dim wwww
Dim aktWb As Workbook
Set aktWb = ActiveWorkbook
strPath = "C:\Werkstatt\Lager"
Set objSh = ActiveSheet
'------- akt. Sheet Name in Zellen setzen ----------
Dim vn As String
vn = ActiveSheet.name
ActiveSheet.Cells(1, 8).Value = vn
'----------- akt. Sheet Name mit Datum -------------
Dim dn As String
dn = ActiveSheet.name & "   Teile Nr. vom" & Cells(4, 1) & ".xls"
ActiveSheet.Cells(2, 8).Value = dn
strPathCe = "C:\Werkstatt\Lager\" & ActiveSheet.Cells(1, 8).Value
OrdNam1 = "C:\Werkstatt\"
OrdNam3 = ActiveSheet.Cells(1, 8).Value                 'Lager Name allein
OrdNam4 = ActiveSheet.Cells(2, 8).Value                 'Teile-Abt allein
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
If Dir(strPathCe, vbDirectory) <> "" Then
Else
MsgBox "Verzeichnis Lager ist NICHT  vorhanden"
MkDir strPathCe
End If
If Dir(strPathCe & "\" & OrdNam4, 16) <> "" Then
blnExist = True
If MsgBox("Die Datei: " & vbLf & vbLf & vbTab & Chr(34) & OrdNam4 & Chr(34) _
& "          " & vbLf & vbLf & "Im Verzeichnis: " & vbLf & vbLf & _
vbTab & Chr(34) & strPathCe & Chr(34) & vbLf & _
vbLf & vbLf & "ist bereits vorhanden!" & vbLf & vbLf & _
"Soll die Datei ersetzt werden ?", 36, "Frage") = 7 Then
blnClose = True
GoTo ErrExit
End If
End If
For Each objWb In Workbooks
If MsgBox("Die Datei: " & vbLf & vbLf & vbTab & Chr(34) & OrdNam4 & Chr(34) & _
Space(15) & vbLf & vbLf & "ist zur Zeit geöffnet!" & vbLf & vbLf & _
"Um fortzufahren, muss die Datei geschlossen werden!", 33, "Frage") = 2 Then
blnClose = True
GoTo ErrExit
End If
ActiveWorkbook.Save                 'neu gesetzt
objWb.Close False               'alte Mappe
Exit For
End If
Next
objSh.Copy
With ActiveWorkbook
Application.DisplayAlerts = False                 ' Sicherheitsabfrage unterdrücken
.SaveAs strPathCe & "\" & OrdNam4
End With
ErrExit:
If Err.Number = 0 Then
If blnClose Then
MsgBox "Der Vorgang wurde Abgebrochen!  ", 64, "Hinweis"
Exit Sub
Else
MsgBox "Die Datei: " & vbLf & vbLf & vbTab & Chr(34) & OrdNam4 & Chr(34) & _
"                 " & vbLf & vbLf & _
"Im Verzeichnis: " & vbLf & vbLf & vbTab & Chr(34) & strPathCe & Chr(34) & _
vbLf & vbLf & vbTab & Space(15) & _
vbLf & vbLf & "wurde erfolgreich " & IIf(blnExist, "ersetzt", "erstellt") & "!", 64, "Hinweis"
End If
Else
'MsgBox "Beim speichern der Datei" & vbLf & vbLf & vbTab & strPath & objSh.Name & ".xls" & Space(15) & _
'    vbLf & vbLf & "trat folgender Fehler auf" & vbLf & vbLf & Err.Description & Space(15), 48, "Fehler"
Err.Clear
End If
Set objSh = Nothing
'- hier die erstellte Datei rein -----
Dim aaw
Set aaw = ActiveWorkbook
aktWb.Activate
With ActiveWorkbook
If .name Like "Werkstatt.xls" Then
'MsgBox "Walter"
Else
With ActiveWorkbook
If Not .name Like "Center*" Then
MsgBox "Die Datei: " & vbLf & vbLf & .name & vbLf & vbLf & _
"wird jetzt mit dem Orginal-Namen gespeichert !    "
strPathCe = aktWb.Path & "\" & aktWb.name
aktWb.Close
Kill strPathCe
Else
MsgBox "Die Datei: " & vbLf & vbLf & .name & vbLf & vbLf & _
"hat einen Lager-Namen, wird nicht gelöscht !   "
End If
End With
End If
End With
aaw.Activate
End Sub

mfg Walter
Anzeige
Das war hier>https://www.herber.de/forum/messages
15.12.2006 19:17:47
Walter
Hallo,
das war hier: https://www.herber.de/forum/messages/829564.html
gemeint, vielleicht gibt es denoch einen weiteren Tip, wie ich
es "angehen" sollte !
mfg Walter
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige