MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Excel
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 13.10.2018, 18:32   #1
Tobias3107
Neuer Benutzer
Neuer Benutzer
Standard VBA - In Excel per Button Werte vergleichen und Zeilennummer ausgeben

Hallo,

ich habe hier eine Exceltabelle mit ca. 2000 Zeilen und 60 Spalten.
Ich würde gerne per Button die Zeilen vergleichen lassen, und bei einer Abweichung von z.b. kleiner als 0.5 eine MsgBox erscheinen lassen mit der Info, dass eine ähnliche Zeile schon existiert(mit der Zeilennummer).

Ausgangsituation:
In den Zellen sind Abmessungen für 3D-Körper von verschiedenen Werkzeughaltern. In der ersten Spalte steht hierbei immer der Bauteilname und in den restlichen Spalten die Abmessungen, jede Zeile entspricht ein Werkzeughalter. Wenn nun ein neuer Werkzeughalter konstruiert wird, werden die Abmessungen in eine Exceltabelle gelistet, hierbei soll anschließend verglichen werden, ob ein solch ähnlicher Werkzeughalter schon konstruiert wurde.

Richtig super wäre es, wenn man pro Spalte eine individuelle Abweichung angeben kann, dass z.b. in der Spalte F eine Abweichung von 1mm zulässig ist und in Spalte Y nur 0.05, bzw. Spalte A darf gar nicht verglichen werden, da hier ja die Bauteilnamen stehen.

Ich hoffe ihr versteht mein Problem


Vielen Dank im voraus

mit freundlichen Grüßen
Tobias
Tobias3107 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.10.2018, 10:50   #2
MisterBurns
MOF Koryphäe
MOF Koryphäe
Standard

Zitat:

Ich hoffe ihr versteht mein Problem

Yup. Allerdings wirst du schon eine Beispielmappe hochladen müssen, die für diesen Fall zumindest 20 Zeilen enthält, damit man das Ganze auch ordentlich testen kann. Ansonsten wird sich das vermutlich niemand antun wollen.

__________________

Schöne Grüße
Berni
MisterBurns ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.10.2018, 12:39   #3
Tobias3107
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hallo,

danke für die schnelle Antwort.

Hier ist eine Beispieldatei.

In Zeile 1 und 2 sind Überschriften.
In Spalte 1 ist der Bauteilname (=Dateiname)
Und B,C,D,E sind hier die Abmessungen.
Die zulässigen Abweichungen stehen ganz unten.

Später werden es vermutlich über 2000 Zeilen und ca. 60 Spalten.

Ziel ist es, hier die Werte vergleichen zu lassen und eine MsgBox erscheinen zu lassen, in welcher hervorgeht dass Halter3(=Zeile5) und Halter20(=Zeile22) ähnlich sind.
Angehängte Dateien
Dateityp: xls Haupttabelle.xls (9,9 KB, 5x aufgerufen)

Geändert von Tobias3107 (14.10.2018 um 14:14 Uhr).
Tobias3107 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.10.2018, 13:36   #4
WS-53
MOF Koryphäe
MOF Koryphäe
Standard

Hallo Tobias,

wenn du 60 Spalten und demnach 59 Maße hast, was bringt es dur dann zu erfahren, dass es zu dem Maß einer Spalte mindestens eine Zeile gibt, in der dieses Maß eine Abweichung kleiner der Vorgabe hast. Die anderen 58 Maße können dann doch dann immer noch völlig andere sein.

Aus deinem reduzierten Beispiel geht auch nicht hervor, wie nun das Ergebnis aussehen sollte.

__________________

VG, WS-53


>>> Ein Spezialist kann nicht viel, dies aber gut. Die Steigerung ist, noch weniger noch besser zu können. Die Krönung ist, nichts zu können, aber darin perfekt zu sein! Es gibt aber auch Naturtalente, die überspringen die Ersten beiden Stufen. <<<

Übrigens, Feedback, egal welcher Art, ist immer hilfreich. Und erledigte Beiträge sollten auch den Status "erledigt" erhalten.
WS-53 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.10.2018, 13:53   #5
Tobias3107
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Zitat: von WS-53 Beitrag anzeigen

Hallo Tobias,

wenn du 60 Spalten und demnach 59 Maße hast, was bringt es dur dann zu erfahren, dass es zu dem Maß einer Spalte mindestens eine Zeile gibt, in der dieses Maß eine Abweichung kleiner der Vorgabe hast. Die anderen 58 Maße können dann doch dann immer noch völlig andere sein.

Aus deinem reduzierten Beispiel geht auch nicht hervor, wie nun das Ergebnis aussehen sollte.

Hallo, danke für die Antwort.

Stimmt, da hast du vollkommen Recht! Es darf nicht nur 1 Spalte verglichen werden, sondern jede Spalte. Somit müssen in allen 59 Spalten die Maße in der Abweichung liegen. Die individuellen Abmessungen sind jedoch zweitrangig, wenn dies zum programmieren zu viel Aufwand ist, müsste man eine allgemeine Abweichung von z.b. 1mm annehmen. Somit müssen nur noch ganze Zeilen(mit Ausnahme Spalte A) verglichen werden.
Man müsste wahrscheinlich irgendwie mit Schleifen arbeiten, man fängt bei Spalte B an, vergleicht diese, dann werden alle Zeilen gemerkt, welche in der Abweichung liegen. Dann lässt man Spalte C mit den übriggeblieben Zeilen von Spalte B vergleichen, und merkt sich wieder die Zeilen. Danach Spalte D mit den übriggeblieben von Spalte C und so weiter. Jedoch weiß ich nicht wie man dies mit VBA umsetzen kann

Das Ergebniss wäre eine einfache Meldung wie z.B. einer MsgBox dass es identische Halter schon gibt.

PS. Den Anhang hab ich überarbeitet, da ich von MisterBurns die 20 Zeilen überlesen habe. Ich habe nun 20 Halter hinzugefügt.

Geändert von Tobias3107 (14.10.2018 um 14:15 Uhr).
Tobias3107 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.10.2018, 16:16   #6
MisterBurns
MOF Koryphäe
MOF Koryphäe
Standard

Hallo Tobias,

ich habe in deiner Beispieldatei die Zeile mit den Toleranzen in Zeile 2 verschoben, dort sollte sie fix stehen bleiben.

Code:

Sub Ueberpruefen()
Dim x As Long, Z As Long, S As Long, Abw As Long, Zaehler As Long

x = Cells(Rows.Count, 1).End(xlUp).Row
Abw = 2

For Z = 4 To x - 1
    Zaehler = 0
        For S = 2 To Cells(2, Columns.Count).End(xlToLeft).Column
            If Cells(x, S) <= Cells(Z, S) + Cells(Abw, S) And Cells(x, S) >= Cells(Z, S) - Cells(Abw, S) Then
                Zaehler = Zaehler + 1
            End If
        Next S
    If Zaehler >= 3 Then MsgBox "Ähnliches Werkzeug in Zeile " & Z & " mit Bezeichnung " _
    & Cells(Z, "A") & " gefunden!"          'If Zaehler >= 3 auf die passende Spaltenanzahl ändern!
Next Z

End Sub
Den Teil
Code:

If Zaehler >= 3
musst du auf abändern auf die richtige Spaltenanzahl. Also wenn insgesamt 61 Spalten belegt sind (inkl. Spalte A für die Bezeichnung), dann statt 3 den Wert 60 eintragen.

__________________

Schöne Grüße
Berni
MisterBurns ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.10.2018, 16:39   #7
Tobias3107
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Vielen vielen Dank!!!
Es funktioniert super!!!

Aber wäre es möglich, dass nicht nur der Halter in der letzten Zeile verglichen wird, sondern alle? Dann müsste jedoch auch die Ausgabe in der MsgBox geändert werden, damit hier beide betreffenden Zeilen ausgegeben werden.
Tobias3107 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.10.2018, 19:57   #8
WS-53
MOF Koryphäe
MOF Koryphäe
Standard

Hallo Tobias,

anbei mal ein Formelansatz. Ich habe dazu die Maßspalten auf 10 erhöht. Anschliessend gibt es zu jeder Maßsspalte eine Zählspalte, in der gezählt wird, wie viele Teile es gibt, die sich in der Toleranz befinden. Am Ende in Spalte V wird gezählt, wie häufig es mindestens ein weiteres Maß in der jeweiligen Toleranz gibt.


Und in dieser Spalte kannst du nun nach Anzuahl der Übereionstimmungen innerhalb der jeweiligen Tolerangrenzen filtern und sihst sofort die jeweiligen Teile.

__________________

VG, WS-53


>>> Ein Spezialist kann nicht viel, dies aber gut. Die Steigerung ist, noch weniger noch besser zu können. Die Krönung ist, nichts zu können, aber darin perfekt zu sein! Es gibt aber auch Naturtalente, die überspringen die Ersten beiden Stufen. <<<

Übrigens, Feedback, egal welcher Art, ist immer hilfreich. Und erledigte Beiträge sollten auch den Status "erledigt" erhalten.
WS-53 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.10.2018, 20:36   #9
Tobias3107
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Danke für deine Hilfe und der beanspruchten Zeit,
ich werde das ganze morgen mal testen! Ist auf den ersten Blick ebenfalls eine gute Lösung, ganz ohne VBA.

mit freundlichen Grüßen
Tobias
Tobias3107 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 15.10.2018, 20:39   #10
Tobias3107
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Zitat: von WS-53 Beitrag anzeigen

Hallo Tobias,

anbei mal ein Formelansatz. Ich habe dazu die Maßspalten auf 10 erhöht. Anschliessend gibt es zu jeder Maßsspalte eine Zählspalte, in der gezählt wird, wie viele Teile es gibt, die sich in der Toleranz befinden. Am Ende in Spalte V wird gezählt, wie häufig es mindestens ein weiteres Maß in der jeweiligen Toleranz gibt.


Und in dieser Spalte kannst du nun nach Anzuahl der Übereionstimmungen innerhalb der jeweiligen Tolerangrenzen filtern und sihst sofort die jeweiligen Teile.


Hallo, prinzipiell gefällt mir dein Ansatz, jedoch ist dies bei 60 Spalten ziemlich unübersichtlich und man weiß auch nicht direkt welcher Halter mit welchem übereinstimmt.
Trotzdem vielen vielen Dank für deine Mühe!!
Hier gefällt mir dann die VBA Lösung von MisterBurns doch besser. Ich hoffe ich kann mich irgendwann mal arrangieren.

Mit freundlichen Grüßen
Tobias3107 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 16.10.2018, 08:44   #11
MisterBurns
MOF Koryphäe
MOF Koryphäe
Standard

Hallo Tobias,

du wolltest ja noch eine Lösung, um die bestehenden Werkzeughalter alle miteinander abzugleichen. Ich muss gestehen, das war für meine VBA-Künste eine rechte Nuss, aber ich glaube ich habe es hinbekommen. Es geht garantiert irgendwie eleganter, aber dazu bin ich zu sehr Spagetthicodeschreiber. Versuch mal das:

Code:

Sub ueberpruefen()
Dim Z As Long, S As Long, Zaehler As Long, ZZaehler As Long
Dim lastZ As Long, lastS As Long
Dim Gleich As Integer

lastZ = Cells(Rows.Count, 1).End(xlUp).Row
lastS = Cells(4, Columns.Count).End(xlToLeft).Column
ZZaehler = 1

Application.ScreenUpdating = False

For Z = 4 To lastZ - 1
Gleich = 0
naechsteZZeile:
    For S = 2 To lastS
        If Cells(Z, S) + Cells(2, S) >= Cells(Z + ZZaehler, S) And Cells(Z, S) - Cells(2, S) <= Cells(Z + ZZaehler, S) Then
            Gleich = Gleich + 1
        End If
    Next S
    
    If ZZaehler >= lastZ - Z Then
        ZZaehler = 1
        Gleich = 0
        GoTo naechsteZeile
    Else
        If Gleich >= lastS - 1 Then
            Cells(Z, Cells(Z, Columns.Count).End(xlToLeft).Column + 1) = "Ident mit " & Cells(Z + ZZaehler, 1)
            Cells(Z + ZZaehler, Cells(Z + ZZaehler, Columns.Count).End(xlToLeft).Column + 1) = "Ident mit " & Cells(Z, 1)
        End If
        Gleich = 0
        ZZaehler = ZZaehler + 1
    End If
    
    If S >= lastS Then
        S = 2
        GoTo naechsteZZeile
    End If

naechsteZeile:
Next Z

Application.ScreenUpdating = True

End Sub
Zur Info: Bei einer Übereinstimmung wird in den beiden betreffenden Zeilen in der ersten freien Spalte ein Hinweis auf den jeweils anderen Datensatz eingefügt.

Ich würde an deiner Stelle die beiden Codes unabhängig voneinander laufen lassen, sprich zuerst die bestehenden Datensätze abgleichen. Den ersten (ursprünglichen) Code kannst du dann ja für den täglichen Einsatz verwenden, da ja dann nur noch neu hinzukommende Einträge überprüft werden müssen.

__________________

Schöne Grüße
Berni
MisterBurns ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 16.10.2018, 20:33   #12
WS-53
MOF Koryphäe
MOF Koryphäe
Standard

Hallo Berni,

ich denke, das hast du soweit gut gemacht!

Aber du hast nicht ordentlich getestet. Denn wenn du in Spalte F deine Vergleichsergebnisse ausgibst, dann musst beim nächsten Durchlauf entweder den Inhalt von Spalte F löschen oder du darfst diese nicht berücksichtigen. Denn sonst will dein Makro auf die Texte Rechenoperationen anwenden und läuft auf den Fehler 13 (Typen unverträglich). Da ja nun LastS den Wert 6 anstatt 5 enthält.

Du musst somit in der Überschriftszeile einen Spaltentitel setzten, wenn es diesen noch nciht gibt und dann von LastS immer 1 abziehen.

Ein weiterer Fehler ist, dass wenn das Produkt der letzten Zeile mit einem anderen übereinstimmt, dann wird dies nicht erkannt. Erst wenn du dann noch ein weiteres neues Produkt einfügst, dann wirde das die Übereinstimmung innerhalb der Tolerangrenzen erkannt.

Aber ich denke, dies sind Kleinigkeiten, die du bewältigt bekommst.

__________________

VG, WS-53


>>> Ein Spezialist kann nicht viel, dies aber gut. Die Steigerung ist, noch weniger noch besser zu können. Die Krönung ist, nichts zu können, aber darin perfekt zu sein! Es gibt aber auch Naturtalente, die überspringen die Ersten beiden Stufen. <<<

Übrigens, Feedback, egal welcher Art, ist immer hilfreich. Und erledigte Beiträge sollten auch den Status "erledigt" erhalten.
WS-53 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 17.10.2018, 08:45   #13
MisterBurns
MOF Koryphäe
MOF Koryphäe
Standard

Hallo WS,

danke für das Lob und deine Hinweise, da habe ich wohl wirklich nicht lange genug getestet (da bin ich gerne faul )
Ich bin ehrlich gesagt gar nicht auf die Idee gekommen, dass es einen nächsten Durchlauf geben könnte, denn eigentlich ist das ein Einmalmakro. Für alle zukünftigen Einträge gibt es das Makro aus Beitrag #6, was wesentlich effizienter ist, da nur die neu hinzugekommenen Einträge geprüft werden.

Bevor ich den Code jetzt noch verbessere, warte ich ab, ob sich der TE nochmal meldet oder ob der Beitrag für ihn schon erledigt ist. Denn für die Tonne mag ich ja auch nicht arbeiten.

__________________

Schöne Grüße
Berni
MisterBurns ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 17.10.2018, 23:04   #14
Tobias3107
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hallo MisterBurns,
erstmal Danke dass du solange mit mir durchhältst :P

Die Tipps von WS-53 hab ich gelesen, jedoch verstehe ich nicht so ganz was er damit meint..

Der Code funktioniert bis auf die von WS-53 genannten Fehler. Es wäre mir noch eine sehr große Hilfe wenn du dies noch überarbeiten würdest.
Morgen kann ich auch wegen den AddIn, welches du mir empfohlen hast, zum Hinzufügen von neuen Haltern aus den anderen Beitrag von mir nachschauen.

Mit freundlichen Grüßen
Tobias Lehner
Tobias3107 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 18.10.2018, 09:37   #15
MisterBurns
MOF Koryphäe
MOF Koryphäe
Standard

Morgen Tobias,

die Tipps bezogen sich darauf, dass ja der letzte gepostete Code sämtliche Zeilen miteinander abgleicht. Und bei einem Treffer, sprich Gleichheit zweier Zeilen innerhalb der Toleranz, wird dieser Treffer in der ersten freien Spalte der betreffenden Zeile eingetragen. So weit so gut.
Wenn du das Makro aber nun ein zweites Mal durchlaufen lässt, stehen diese Einträge ja immer noch da und es werden dann die Treffer erneut hinter den bereits bestehenden Einträgen hinzugefügt. Und das jedes mal, wenn du das Makro ausführst.

Und der zweite Punkt war, dass die letzte Zeile in der Werkzeugliste zwar korrekt überprüft, bei einem Treffer aber keine diesbezüglicher Eintrag hinzugefügt wird.

Diese beiden Sachen habe ich noch korrigiert. Zwar auf eine ziemlich unelegante Weise (Sprungmarken wären wesentlich besser), aber ich hab schön langsam einen Knopf im Hirn. Da sieht man einfach, dass ich kein Programmierer bin. Ich denke aber, dass es für dich egal ist, der Code sollte nun korrekt laufen und die gewünschten Ergebnisse anzeigen.

Code:

Sub ueberpruefen()
Dim Z As Long, S As Long, Zaehler As Long, ZZaehler As Long
Dim lastZ As Long, lastS As Long
Dim Gleich As Integer

lastZ = Cells(Rows.Count, 1).End(xlUp).Row
lastS = Cells(1, Columns.Count).End(xlToLeft).Column
ZZaehler = 1

Application.ScreenUpdating = False

Range(Columns(lastS + 1), Columns(lastS + 100)).ClearContents

For Z = 4 To lastZ - 1
naechsteZZeile:
Gleich = 0
    For S = 2 To lastS
        If Cells(Z, S) + Cells(2, S) >= Cells(Z + ZZaehler, S) And Cells(Z, S) - Cells(2, S) <= Cells(Z + ZZaehler, S) Then
            Gleich = Gleich + 1
        End If
    Next S
    
    If ZZaehler >= lastZ - Z Then
        If Gleich >= lastS - 1 Then
            Cells(Z, Cells(Z, Columns.Count).End(xlToLeft).Column + 1) = "Ident mit " & Cells(Z + ZZaehler, 1)
            Cells(Z + ZZaehler, Cells(Z + ZZaehler, Columns.Count).End(xlToLeft).Column + 1) = "Ident mit " & Cells(Z, 1)
        End If

        ZZaehler = 1
        GoTo naechsteZeile
    Else
        If Gleich >= lastS - 1 Then
            Cells(Z, Cells(Z, Columns.Count).End(xlToLeft).Column + 1) = "Ident mit " & Cells(Z + ZZaehler, 1)
            Cells(Z + ZZaehler, Cells(Z + ZZaehler, Columns.Count).End(xlToLeft).Column + 1) = "Ident mit " & Cells(Z, 1)
        End If
        ZZaehler = ZZaehler + 1
    End If
    
    If S >= lastS Then
        S = 2
        GoTo naechsteZZeile
    End If

naechsteZeile:
Next Z

Application.ScreenUpdating = True

End Sub

__________________

Schöne Grüße
Berni
MisterBurns ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 17:05 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.