Herbers Excel-Forum - das Archiv

Zahlen vergleichen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: Zahlen vergleichen
von: Walter

Geschrieben am: 14.12.2006 13:02:46
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
Bild

Betrifft: Bitte dringend, hier noch
von: WalterB

Geschrieben am: 14.12.2006 15:18:07
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

Bild

Betrifft: AW: Zahlen vergleichen
von: fcs

Geschrieben am: 14.12.2006 15:45:18
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

Bild

Betrifft: Super aber noch
von: Walter

Geschrieben am: 14.12.2006 16:22:01
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
Bild

Betrifft: AW: Super aber noch
von: fcs

Geschrieben am: 14.12.2006 19:17:33
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
Bild

Betrifft: Ja aber
von: Walter

Geschrieben am: 14.12.2006 20:00:58
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
Bild

Betrifft: AW: Ja aber
von: fcs

Geschrieben am: 14.12.2006 20:42:37
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

Bild

Betrifft: Danke aber die Frage
von: Walter

Geschrieben am: 14.12.2006 20:57:30
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
Bild

Betrifft: AW: Danke aber die Frage
von: fcs

Geschrieben am: 14.12.2006 22:41:40
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

Bild

Betrifft: Leider noch
von: Walter
Geschrieben am: 15.12.2006 10:42:56
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
Bild

Betrifft: Prima ... und zu
von: zu
Geschrieben am: 15.12.2006 11:46:25
Du scheinst nicht unbedingt zu den Top 1000 der Forumsintelligenz zu gehören
Bild

Betrifft: Hallo Franz habe -)
von: Walter

Geschrieben am: 15.12.2006 18:44:20
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
Bild

Betrifft: AW: Forumsintelligenz
von: fcs

Geschrieben am: 16.12.2006 08:49:26
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
Bild

Betrifft: @ walter.buhl@t-online @
von: Orakel
Geschrieben am: 14.12.2006 22:55:33
Hallo Walter,
was ist damit???
https://www.herber.de/forum/messages/829564.html
Verarschen kann ich mich alleine !
Bild

Betrifft: Korrektue
von: Orakel
Geschrieben am: 14.12.2006 23:06:00
https://www.herber.de/forum/messages/828906.html
Bild

Betrifft: Verarschen will ich ...
von: Walter
Geschrieben am: 15.12.2006 07:21:38
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
Bild

Betrifft: Prima ... und zu ...
von: zu

Geschrieben am: 15.12.2006 07:37:02
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 ?
Bild

Betrifft: Hallo habe doch Problem, hier mein Makro
von: Walter

Geschrieben am: 15.12.2006 12:39:54
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
Bild

Betrifft: Das war hier>https://www.herber.de/forum/messages
von: Walter

Geschrieben am: 15.12.2006 19:17:47
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
Bild

Betrifft: AW: hier sollte das wohl hin
von: hier hin

Geschrieben am: 15.12.2006 23:39:15
https://www.herber.de/forum/messages/829894.html
 Bild
Excel-Beispiele zum Thema "Zahlen vergleichen"
Vorkommen von Zahlenreihen in Spalten Zeichenfolgen in Zahlen nach Textimport
Zahlenformatierung mit Punkt nach der 1. Ziffer Namen von TextBoxes hochzählen
Zählen formatierter Zellen Autofilter auch mit Ziffern von Zahlen
Addition der absoluten Zahlen Eingabe von positiven Zahlen erzwingen
Zufallszahlen generieren, die sich nicht wiederholen Summenformel unter Zahlenreihe eintragen