die Maschine ist in 2017 drin. Aktuell versuche ich das ja mit den Dateien zu testen die ich dir auch gegeben habe.
Die Maschine ist in Zeile 185 nicht 285 war ein Schreibfehler. Da könntest du mal gucken bei mir ändert er diese nämlich nicht. Hatte die zum Test bei mir mal Rot gemacht die ganze schrift um zu sehen ob was passiert.
23.01.2018, 15:07 (Dieser Beitrag wurde zuletzt bearbeitet: 23.01.2018, 15:08 von UltraTM.)
Hallo Gast,
also ich habe das ganze mal mit in Overview suchen gemacht anstatt in Delivered.
Dabei macht er schon mal eine gute Sache. Allerdings scheint er Probleme zu machen bei den Zeilen wo ja 2 Seriennummern drin sind.
In meinem Test hatte er diese zwei als nein gemacht obwohl es welche sind die ich in Overview finde also eben da sind.
Wie diese 2 nummern:
201717006035136
201317023034063
Die macht er mir Nein obwohl sie dann ja sein sollten.
Auch ist mir aufgefallen bei dem Suchenblatt wenn man beim Suchkriterium nur ganzes Wort aktiv hat findet er eine doppelte Maschine auch nicht das muss raus. Ist ja eigentlich klar da man nur einen Teil der ganzen Zelle sucht. Könnte das evtl auch das Seriennummerproblem zurück zu führen sein?
Grüße René
Hier der Code den ich mit deinem neuen auf Overview umgebaut hatte:
Code:
Option Explicit '20.1.2017 Gast 123 Clever Form
'Modul1 ForDel
Const AbgDatei = "Datei_zum_Abgleich" 'Original Name der Abgleich Datei
Const Deliver1 = "Overview" 'kann jedes Jahr geandert werden
Const MaschSpa = "F" 'Spalte der Maschinen Nummer (F) oder als Nummer
Const MZ1 = 19 '1.Zeile in Maschinenliste wahlweise 19 oder 22
'Module für Serien Nr in Delivered
Sub SerienNr_vergleichen_ForNext()
Dim lzDV As Long, lzML As Long
Dim MaschNr As String, d1 As Long
Dim i As Long, n As Long, j As Long
Dim Wb As Workbook, DEL As Worksheet
On Error GoTo Fehler
Set Wb = Workbooks(AbgDatei)
Set DEL = Wb.Worksheets(Deliver1)
lzDV = DEL.Cells(Rows.Count, 1).End(xlUp).Row
'Aktion des prüfens und ändern
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("Maschinenliste")
lzML = .Cells(Rows.Count, 1).End(xlUp).Row
'ganze Spalte G auf "Nein" setzen
.Range("G" & MZ1 & ":G" & lzML) = "Nein"
'Schleife zum suchen der Serien-Nr in angegebenem Blatt
For j = MZ1 To lzML
Application.StatusBar = lzML & " / " & j
MaschNr = .Cells(j, 5).Value
If Left(MaschNr, 1) = "!" Then MaschNr = Mid(MaschNr, 2, 50)
For i = 2 To lzDV
If DEL.Cells(i, MaschSpa) = MaschNr Then
If .Cells(j, 7) = "Nein" Then
.Cells(j, 7) = "Ja"
n = n + 1: Exit For
Else
.Cells(j, 7) = "Ja / dopp"
d1 = d1 + 1: Exit For
End If
End If
Next i
Next j
End With
Application.ScreenUpdating = True
If d1 > 0 Then MsgBox d1 & " doppelte im Blatt gefunden"
MsgBox n & " Serien Nr. gefunden"
Exit Sub
Fehler: MsgBox "unerwarteter Fehler - existiert das gewünschte Blatt ??"
End Sub
Kurzes Edit: Also mit der ForEach finde ich 41 Maschinen wenn ich in Overview suche. Mit der Find Methode finde ich 76 Maschinen welches zwar länger dauert aber sich als richtig erweist.
Damit sind auch die Maschinen die bei ForEach falsch waren auch richtig drin.
Habe das natürlich live mit aktuellen Dateien getestet.
Habe die Find auch mal etwas umgebaut das ich oben Const eingeben kann.
23.01.2018, 15:50 (Dieser Beitrag wurde zuletzt bearbeitet: 23.01.2018, 15:50 von UltraTM.)
Hallo nochmal Gast 123,
sorry wegen dem erneuten Post aber ich konnte ihn nicht abändern/ergänzen anscheinend eine Zeichenbegrenzung.
Habe nun das System an meinen aktuellen Dateien getestet mit der Overviewseite und eben bei der ForEach findet er live nur 41 maschinen die Ja sind
und mit find 76 und er erkennt auch die oben beschrieben falschen Maschinen richtig (bei der Find Methode) (die 2 zeilen maschinen da er eben xPart sucht und nicht whole)
Habe es wie folgt gebaut um auch oben Const haben zu können:
Code:
Option Explicit '20.1.2017 Gast 123 Clever Form
Const AbgDatei = "MASTER HTIG PRODUCTION.xlsx" 'Original Name der Abgleich Datei
Const Deliver1 = "Overview" 'kann jedes Jahr geandert werden
Const MaschSpa = "F" 'Spalte der Maschinen Nummer (F) oder als Nummer
Const MZ1 = 19 '1.Zeile in Maschinenliste wahlweise 19 oder 22
'Module für Serien Nr in Delivered
'MS-Find Methode (ist sehr langsam!!)
Sub SerienNr_vergleichen_Find()
Dim lzDV As Long, lzML As Long, OldTxt
Dim rFind As Range, MaschNr As String
Dim Wb As Workbook, DEL As Worksheet
Dim i As Long, n As Long, j As Long
Set Wb = Workbooks(AbgDatei)
Set DEL = Wb.Worksheets(Deliver1)
lzDV = DEL.Cells(Rows.Count, 1).End(xlUp).Row
'[f1,f2] = Time '** nur zum Test, spaeter bitte löschen
OldTxt = Application.StatusBar
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("Maschinenliste")
lzML = .Cells(Rows.Count, 1).End(xlUp).Row
'ganze Spalte G auf "Nein" setzen
.Range("G" & MZ1 & ":G" & lzML) = "Nein"
'Schleife zum suchen der Serien-Nr in Delivered
For j = MZ1 To lzML
Application.StatusBar = lzML & " / " & j
MaschNr = .Cells(j, 5).Value
If Left(MaschNr, 1) = "!" Then MaschNr = Mid(MaschNr, 2, 50)
Set rFind = DEL.Columns(MaschSpa).Find(What:=MaschNr, after:=Cells(1, MaschSpa), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
If Not rFind Is Nothing Then _
.Cells(j, 7) = "Ja": n = n + 1
Next j
End With
[f2] = Time '** nur zum Test, spaeter bitte löschen
Application.StatusBar = OldTxt
Application.ScreenUpdating = True
MsgBox n & " Serien Nr. gefunden"
vielleicht ist kurz vor meinem Urlaub noch ein entscheidender Durchbruch beim Serien Nummer Problem gelungen!
Dann würde ich vor Freude "Juhu" schreien.... Bin gespannt auf deine Antwort mit den "echten Daten"!!
Ich hatte schon mal mit der Serien Nummer experimentiert, indem ich sie in Teilstrings zerlegt hatte, aber ohne Erfolg. Bei dem neuen Makro unten habe ich eine zweite Dim Variable angelegt: Dim DMaschNr As String - MaschNr für Delivered Sheet. Hole beide Maschinen Nr in eine Variable!!
Der Vorteil, in einer Variablen kann ich die Nummern bearbeiten ohne die Originale zu verfaelschen. Und jetzt der simple Trick, wenn er funktioniert. Ich lösche aus beiden Serien Nummern konsequent den Zeilenumbruch und die Space " " heraus. Übrig bleibt die nackte Nummer als langer String. Diese beiden Strings vergleiche ich miteinander.
Das Ergebnis: in deiner alten Liste findet das Makro jetzt auf Anhieb 248 Serien Nummern. Ich bin gespannt auf dein Ergebnis mit echten Daten. Wenn das klappt kannst du den Trick ja auch ins Makro für 2017 und 2018 einbauen, und versuchen es in den Suchlauf zu bekommen! Dann müsste der aber evtl. von Find Methode auf die For Next Methode umgestellt werden. Dafür habe ich aber keine Zeit mehr!!
Würde mich sehr freuen wenn wir das Serien Nummern Problem doch noch in den Griff bekommen haben ...
mfg Gast 123
Code:
'Schleife zum suchen der Serien-Nr in angegebenem Blatt
For j = MZ1 To lzML
Application.StatusBar = lzML & " / " & j
'Maschinen Nummer in "Meine Datei"
'Zeilenumbruch und " " löschen!!
MaschNr = .Cells(j, 5).Value
MaschNr = Replace(MaschNr, " ", "")
MaschNr = Replace(MaschNr, Chr(10), "")
If Left(MaschNr, 1) = "'" Then MaschNr = Mid(MaschNr, 2, 50)
For i = 2 To lzDV
'Maschinen Nummer in "Delivered 2017"
'Zeilenumbruch und " " löschen!!
DMaschNr = DEL.Cells(i, MaschSpa)
DMaschNr = Replace(MaschNr, " ", "")
DMaschNr = Replace(MaschNr, Chr(10), "")
If DMaschNr = MaschNr Then
If .Cells(j, 7) = "Nein" Then
.Cells(j, 7) = "Ja"
n = n + 1: Exit For
Else
.Cells(j, 7) = "Ja / dopp"
d1 = d1 + 1: Exit For
End If
End If
Next i
Next j
dabei schreibt er mir alle Maschinen die bei mir sind auf Ja.
Ja er findet sehr schnell 264 Maschinen. Aber das ist glaub ich alle die ich in der Liste habe.
Habe es getestet mit der Overview Seite dabei sollte er dann nur die auf Ja stellen die auch drin sind. Normalerweise 74 davon. Er findet aber angeblich alle dort und setzt alle auf ja.
Bei der Find die ich gestern geschrieben hatte sieht das ergebnis plausibel aus.
bin aber Grundsätzlich auch mit der Find Methode zufrieden.
Auch wenn es etwas dauert liefert es das richtige Ergebnis wie es aussieht.
Bin nun nur am tüfteln wie ich in die Userform einen Ladebalken bringe um ein label zu füllen.
Habe mir eine Userform gebaut um dort per knopfdruck die Abfrage zu starten mit eben hinweisen usw.
Auch habe ich die Startzeit: und Endzeit: in Labels dargestellt wie auch das Ergebnis wie viele Maschinen.
Funktioniert alles gut soweit sobald er durch ist aktualisiert er dies.
Nun hänge ich nur am ladebalken. habe einige Beispiele gefunden im Netz nur sind die imm von Schritten abhängig wieviele Schritte dann 100% sein sollen.
ich lade mal die Datei hoch mit dem Demo für den ladebalken.
Vielleicht kannst du da helfen dort die Abfrage von dir einzubauen. Dann würde man visuell sehen wenn sie durch läuft.
Grüße René
Hier die Abfrage mit Find wie sich richtig findet:
Code:
Option Explicit '20.1.2017 Gast 123 Clever Form
Const AbgDatei = "MASTER HTIG PRODUCTION.xlsx" 'Original Name der Abgleich Datei
Const Deliver1 = "Overview" 'kann jedes Jahr geandert werden
Const MaschSpa = "F" 'Spalte der Maschinen Nummer (F) oder als Nummer
Const MZ1 = 19 '1.Zeile in Maschinenliste wahlweise 19 oder 22
'Module für Serien Nr in Delivered
'MS-Find Methode (ist sehr langsam!!)
Sub SerienNr_vergleichen_Find()
Dim lzDV As Long, lzML As Long, OldTxt
Dim rFind As Range, MaschNr As String
Dim Wb As Workbook, DEL As Worksheet
Dim i As Long, n As Long, j As Long
On Error GoTo Fehler
Set Wb = Workbooks(AbgDatei)
Set DEL = Wb.Worksheets(Deliver1)
lzDV = DEL.Cells(Rows.Count, 1).End(xlUp).Row
'[f1,f2] = Time '** nur zum Test, spaeter bitte löschen
OldTxt = Application.StatusBar
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("Maschinenliste")
lzML = .Cells(Rows.Count, 1).End(xlUp).Row
'ganze Spalte G auf "Nein" setzen
.Range("G" & MZ1 & ":G" & lzML) = "Nein"
'Schleife zum suchen der Serien-Nr in Delivered
For j = MZ1 To lzML
Application.StatusBar = lzML & " / " & j
MaschNr = .Cells(j, 5).Value
If Left(MaschNr, 1) = "!" Then MaschNr = Mid(MaschNr, 2, 50)
Set rFind = DEL.Columns(MaschSpa).Find(What:=MaschNr, after:=Cells(1, MaschSpa), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
If Not rFind Is Nothing Then _
.Cells(j, 7) = "Ja": n = n + 1
Next j
End With
Unload UserformProgressbar
'[f2] = Time '** nur zum Test, spaeter bitte löschen
Application.StatusBar = OldTxt
Application.ScreenUpdating = True
MsgBox n & " Maschinen aus der Liste sind in den Produktionshallen."
Exit Sub
mit Ladeblken habe ich mich noch nie beschaeftigt, dazu fehlt mir das technische Wissen.
Vielleicht kann ein Kollege dir da weiterhelfen, ich muss noch wichtige private Dinge erledigen. Der Flieger wartet nicht ...
