Abgleich mit Datei soll erkennen falls ein Unterschied auftritt dann neue Daten schreiben

  • Excel

Es gibt 10 Antworten in diesem Thema. Der letzte Beitrag () ist von UltraTM.

    Abgleich mit Datei soll erkennen falls ein Unterschied auftritt dann neue Daten schreiben

    Hallo,

    und zwar nutze ich eine Form mit einem Code um Daten aus einer anderen Datei abzugleichen/updates zu machen.

    Allerdings macht er dies immer automatisch wenn er diese findet über die Auftragsnummer.


    Was ich nun gerne hätte, wäre folgendes:

    - Wenn er unterschiede findet soll er den Wert in dieser Zeile in Spalte P auf 1 setzen.
    - Sollte alles passen muss nichts gesetzt werden. Es geht mir darum eben sehen zu können welche Zeile wurde verändert.


    Anbei mein aktueller Code welcher wie gesagt per Auftragsnummer sucht und immer die Daten wenn gefunden einfach übernimmt:
    Spoiler anzeigen

    Visual Basic-Quellcode

    1. 'Option Explicit
    3. Const MZ1 = 11 '1.Zeile in Maschinenliste wahlweise 19 oder 22
    4. Const MLZ1 = 2 '1.Zeile in MASTER Liste wahlweise 19 oder 22
    6. Private Sub CommandButton1_Click()
    7. MitKommentar
    8. End Sub
    9. Private Sub MitKommentar()
    10. 'Als erste deklarieren wir unsere Variablen
    11. 'Den Zähler i für die aktuelle Zeile
    12. 'Dim i As Long
    13. 'Die letzte Zeile
    14. 'Dim lzML As Long
    15. 'Variablen um die prozentualen Anteil zu ermitteln
    16. Dim Prozent As Double
    17. Dim ProzentAktuell As Double
    18. Dim ProzentLänge As Double
    19. 'Berechnung Dauer des Vorgangs
    20. Dim DaZeit As Date
    21. DaZeit = Time
    23. 'Die Berechnung
    24. Dim i As Integer, j As Integer
    25. Dim lrOV As Long, lrML As Long
    27. On Error GoTo FehlerVerarbeitung
    29. 'Dim Plan As Workbook: Set Plan = Workbooks("MASTER HTIG PRODUCTION 2022.xlsx")
    30. Dim Plan As Workbook:
    31. Set Plan = Workbooks(ThisWorkbook.Sheets("Maschinenliste").Range("J8").Value)
    33. 'MsgBox Plan.Value
    36. Dim Liste As Workbook:
    38. Set Liste = Workbooks("QC Maschinenliste.xlsm")
    39. 'Dim OVSht As Worksheet: Set OVSht = Plan.Sheets("Overview Machines")
    41. On Error GoTo FehlerVerarbeitung
    44. Dim OVSht As Worksheet
    46. Set OVSht = Plan.Worksheets(ThisWorkbook.Sheets("Maschinenliste").Range("J9").Value)
    48. 'Button deaktivieren
    49. CommandButton1.Enabled = False
    50. 'Zu Fehler springen wenn Blatt/Datei Falsch
    51. On Error GoTo Fehler
    52. 'Set Wb = Workbooks(AbgDatei)
    53. 'Set DEL = Wb.Worksheets(Deliver1)
    54. 'lzDV = DEL.Cells(Rows.Count, 1).End(xlUp).Row
    56. 'Startzeit in Label schreiben
    57. Me.Label34.Caption = Time
    58. 'Andere Label leeren
    59. Me.Label35.Caption = ""
    60. Me.Label37.Caption = ""
    61. Me.Label38.Caption = ""
    62. 'Statusbar alten Text speichern
    63. OldTxt = Application.StatusBar
    64. 'Um das ganze ein wenig zu beschleunigen schalten wir vorübergehend
    65. 'die Bildschirmaktualisierung aus
    66. Application.ScreenUpdating = False
    67. 'Als erstes setzen wir die Variable Prozent auf null
    68. Prozent = 0
    69. With Liste.Sheets("Maschinenliste")
    70. lrML = .Cells(Rows.Count, 3).End(xlUp).Row
    71. lrOV = OVSht.Cells(Rows.Count, 6).End(xlUp).Row
    72. '1.Schleife in Maschinenliste
    73. For i = MZ1 To lrML
    74. '2.Schleife in Overview Sheet
    75. For j = MLZ1 To lrOV
    76. 'in Overview nach Maschinen-Nr. suchen
    77. If Trim(.Cells(i, "B")) = Trim(OVSht.Cells(j, "D")) Then
    79. 'Daten laden wenn alle Zellen Werte haben
    80. 'If Trim(OVSht.Cells(j, "Q")) <> "" Then
    81. If Trim(OVSht.Cells(j, "Q")) = "HTIG" Then
    82. '** Kunde aus Spalte U oder W nehmen??
    83. .Cells(i, 3) = OVSht.Cells(j, "T") 'Auftragsnr.
    84. .Cells(i, 4) = OVSht.Cells(j, "R") 'Land
    85. .Cells(i, 6) = OVSht.Cells(j, "S") 'Kunden Name
    86. .Cells(i, 7) = OVSht.Cells(j, "Y") 'Fertigstellung
    87. .Cells(i, 8) = OVSht.Cells(j, "AB") 'Abholung
    89. ElseIf Trim(OVSht.Cells(j, "Q")) = "HMMI" Then
    90. '** Kunde aus Spalte U oder W nehmen??
    91. .Cells(i, 3) = OVSht.Cells(j, "T") 'Auftragsnr.
    92. .Cells(i, 4) = OVSht.Cells(j, "R") 'Land
    93. .Cells(i, 6) = OVSht.Cells(j, "S") 'Kunden Name
    94. .Cells(i, 7) = OVSht.Cells(j, "Y") 'Fertigstellung
    95. .Cells(i, 8) = OVSht.Cells(j, "AB") 'Abholung
    97. Else
    98. .Cells(i, 3) = OVSht.Cells(j, "T") 'Auftragsnr.
    99. .Cells(i, 4) = OVSht.Cells(j, "R") 'Land
    100. .Cells(i, 6) = OVSht.Cells(j, "Q") 'Kunden Name
    101. .Cells(i, 7) = OVSht.Cells(j, "Y") 'Fertigstellung
    102. .Cells(i, 8) = OVSht.Cells(j, "AB") 'Abholung
    103. End If
    104. End If
    105. 'Da wir die Exceltabelle und die Userform gleichzeitig bearbeitet werden
    106. ' müssen wir einen eine Aufgabe in den Arbeitsspeicher auslagern.
    107. 'Ansonsten sehen wir zur Laufzeit keine Veränderungen an der Progressbar.
    108. 'Um dies zu realisieren übergeben wir die Ermittlung der Wochentage mit
    109. '"Do Events" an den Arbeitspeicher.
    110. DoEvents
    112. 'Um den aktuellen Fortschritt anzeigen zu können ermitteln wir
    113. 'als nächstes anhand unseres Zählers und der letzten Zeile den
    114. 'prozentualen Wert. -1 da wir in der 2. Zeile beginnen.
    115. ProzentAktuell = (i - MZ1) / (lrML - MZ1) * 100
    117. 'Unser Prozentlabel hat eine Länge (width) von 500. Wir teilen
    118. 'diese durch 100 und multiplizieren das Ergebnis mit den zuvor
    119. 'ermittelten Fortschritt. Anschließend können wir unsere Elemente
    120. 'mit diesem Ergebnis exakt positionieren.
    121. ProzentLänge = 500 / 100 * ProzentAktuell
    123. 'Nun zeigen wir unserem User den aktuellen Fortschritt
    124. Prozentanzeige.Caption = Format(ProzentAktuell, "##0") & " %"
    126. 'Außerdem interessiert dem User die aktuelle Position unserer Tabelle
    127. Zeile.Caption = "Zeile " & i & " von " & lrML & " Zeilen bearbeitet "
    129. 'Die Breite unseres Fortschrittbalkens wird um die Prozentlänge erhöht.
    130. Fortschritt.Width = ProzentLänge
    131. 'Hier zeigen wir das aktuelle Datum sowie den ermittelten Tag
    132. aktuellesDatum.Caption = .Cells(i, 1) & "/" & .Cells(i, 2) & " - " & .Cells(i, 3)
    134. 'Die linke Position unserer Prozentanzeige, die "Mitfährt", wird durch die
    135. 'steigende Breite des Fortschrittbalkens nach links verschoben.
    136. '-47 da dies die Breite des Labels ist.
    137. Prozentanzeige.Left = Fortschritt.Width - 47
    139. 'Abhängig vom prozentualen Fortschritt manipulieren wir nun die Farbe unseres
    140. 'Fortschrittslabels und ändern die Caption unserer Userform entsprechend.
    141. Select Case ProzentAktuell
    142. Case Is > 85
    143. 'Me.Caption = "Ich bin gleich fertig"
    144. Fortschritt.BackColor = vbGreen
    145. Case Is < 50
    146. 'Me.Caption = "Es dauert noch eine Weile"
    147. Fortschritt.BackColor = vbRed
    148. Case Is > 49
    149. Fortschritt.BackColor = vbYellow
    150. 'Me.Caption = "Mehr als die Hälfte ist geschafft"
    151. End Select
    152. Next j
    153. Next i
    155. End With
    156. 'Um unser Ergebnis anzuzeigen schalten wir zuletzt die Bildschirmaktualisierung wieder
    157. 'ein
    158. Application.ScreenUpdating = True
    159. 'MsgBox n & " Maschinen aus der Liste sind in den Produktionshallen."
    160. 'Endzeit in Label schreiben
    162. Set Plan = Nothing
    163. Set Liste = Nothing
    165. Me.Label39.Caption = CDate(Time - DaZeit)
    166. Me.Label35.Caption = Time
    167. Application.StatusBar = OldTxt
    168. 'Ergebnis in Labels schreiben
    169. Me.Label37.Caption = " Maschinen wurden abgeglichen"
    170. Me.Label38.Caption = "Viel Spaß beim arbeiten :)"
    171. 'Button deaktivieren
    172. CommandButton1.Enabled = True
    173. Exit Sub
    175. FehlerVerarbeitung:
    177. 'Was tun, wenn ein Laufzeitfehler auftritt?
    179. MsgBox "Fehler aufgetreten, Programm beenden"
    181. 'Fehler: MsgBox "Unerwarteter Fehler - Richtige Datei mit richtigem Blatt geöffnet ??"
    182. Fehler: MsgBox " Datei: " & AbgDatei & " - Blatt: " & Deliver1 & Chr(10) & "Datei geöffnet? und/oder Name richtig geschrieben??" & Chr(10), vbOKOnly, " Fehler bitte prüfen " '& Error()
    183. CommandButton1.Enabled = True
    184. End Sub
    186. Private Sub Image1_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
    188. End Sub
    190. 'Zentrieren auf beiden Bildschirmen des Fenstern
    191. Private Sub UserForm_Initialize()
    192. Dim sngTop As Single, sngLeft As Single
    194. Me.StartUpPosition = 0
    195. sngLeft = Application.Left + Application.Width / 2 - Me.Width / 2
    196. sngTop = Application.Top + Application.Height / 2 - Me.Height / 2
    198. Me.Left = sngLeft
    199. Me.Top = sngTop
    201. Label13 = Date
    202. Label28 = Time
    204. End Sub



    aufgrund des Codeumfangs Spoiler hinzugefügt und CodeTags korrigiert ~VaporiZed

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „VaporiZed“ ()

    Wie folgt habe ich es umgebaut.
    Nur hab ich hier ein Problem das er immer den Status in P auf 1 setzt auch wenn kein Unterschied gefunden wurde.

    Spoiler anzeigen

    Visual Basic-Quellcode

    1. 'Option Explicit
    2. Const MZ1 = 11 '1.Zeile in Maschinenliste wahlweise 19 oder 22
    3. Const MLZ1 = 2 '1.Zeile in MASTER Liste wahlweise 19 oder 22
    4. Private Sub CommandButton1_Click()
    5. MitKommentar
    6. End Sub
    7. Private Sub MitKommentar()
    8. 'Als erste deklarieren wir unsere Variablen
    9. 'Den Zähler i für die aktuelle Zeile
    10. 'Dim i As Long
    11. 'Die letzte Zeile
    12. 'Dim lzML As Long
    13. 'Variablen um die prozentualen Anteil zu ermitteln
    14. Dim Prozent As Double
    15. Dim ProzentAktuell As Double
    16. Dim ProzentLänge As Double
    17. 'Berechnung Dauer des Vorgangs
    18. Dim DaZeit As Date
    19. DaZeit = Time
    21. 'Die Berechnung
    22. Dim i As Integer, j As Integer
    23. Dim lrOV As Long, lrML As Long
    25. On Error GoTo FehlerVerarbeitung
    27. 'Dim Plan As Workbook: Set Plan = Workbooks("MASTER HTIG PRODUCTION 2022.xlsx")
    28. Dim Plan As Workbook:
    29. Set Plan = Workbooks(ThisWorkbook.Sheets("Maschinenliste").Range("J8").Value)
    31. 'MsgBox Plan.Value
    34. Dim Liste As Workbook:
    36. Set Liste = Workbooks("QC Maschinenliste.xlsm")
    37. 'Dim OVSht As Worksheet: Set OVSht = Plan.Sheets("Overview Machines")
    39. On Error GoTo FehlerVerarbeitung
    42. Dim OVSht As Worksheet
    44. Set OVSht = Plan.Worksheets(ThisWorkbook.Sheets("Maschinenliste").Range("J9").Value)
    46. 'Button deaktivieren
    47. CommandButton1.Enabled = False
    48. 'Zu Fehler springen wenn Blatt/Datei Falsch
    49. On Error GoTo Fehler
    50. 'Set Wb = Workbooks(AbgDatei)
    51. 'Set DEL = Wb.Worksheets(Deliver1)
    52. 'lzDV = DEL.Cells(Rows.Count, 1).End(xlUp).Row
    53. 'Startzeit in Label schreiben
    54. Me.Label34.Caption = Time
    55. 'Andere Label leeren
    56. Me.Label35.Caption = ""
    57. Me.Label37.Caption = ""
    58. Me.Label38.Caption = ""
    59. 'Statusbar alten Text speichern
    60. OldTxt = Application.StatusBar
    61. 'Um das ganze ein wenig zu beschleunigen schalten wir vorübergehend
    62. 'die Bildschirmaktualisierung aus
    63. Application.ScreenUpdating = False
    64. 'Als erstes setzen wir die Variable Prozent auf null
    65. Prozent = 0
    66. With Liste.Sheets("Maschinenliste")
    67. lrML = .Cells(Rows.Count, 3).End(xlUp).Row
    68. lrOV = OVSht.Cells(Rows.Count, 6).End(xlUp).Row
    69. '1.Schleife in Maschinenliste
    70. For i = MZ1 To lrML
    71. '2.Schleife in Overview Sheet
    72. For j = MLZ1 To lrOV
    73. 'in Overview nach Maschinen-Nr. suchen
    74. If Trim(.Cells(i, "B")) = Trim(OVSht.Cells(j, "D")) Then
    76. 'Daten laden wenn alle Zellen Werte haben
    77. 'If Trim(OVSht.Cells(j, "Q")) <> "" Then
    78. If Trim(OVSht.Cells(j, "Q")) = "HTIG" Then
    79. '** Kunde aus Spalte U oder W nehmen??
    80. 'Aufragsnummer vergleichen START
    81. If Trim(.Cells(i, "C")) <> Trim(OVSht.Cells(j, "T")) Then
    82. .Cells(i, 3) = OVSht.Cells(j, "T") 'Auftragsnr.
    83. .Cells(i, 16) = 1 'Meistertask Status
    84. 'Auftragsnummer vergleichen ENDE
    85. End If
    86. If Trim(.Cells(i, "D")) <> Trim(OVSht.Cells(j, "R")) Then
    87. .Cells(i, 4) = OVSht.Cells(j, "R") 'Land
    88. .Cells(i, 16) = 1 'Meistertask Status
    89. End If
    90. If Trim(.Cells(i, "D")) <> Trim(OVSht.Cells(j, "S")) Then
    91. .Cells(i, 6) = OVSht.Cells(j, "S") 'Kunden Name
    92. .Cells(i, 16) = 1 'Meistertask Status
    93. End If
    94. If Trim(.Cells(i, "D")) <> Trim(OVSht.Cells(j, "Y")) Then
    95. .Cells(i, 7) = OVSht.Cells(j, "Y") 'Fertigstellung
    96. .Cells(i, 16) = 1 'Meistertask Status
    97. End If
    98. If Trim(.Cells(i, "D")) <> Trim(OVSht.Cells(j, "AB")) Then
    99. .Cells(i, 8) = OVSht.Cells(j, "AB") 'Abholung
    100. .Cells(i, 16) = 1 'Meistertask Status
    101. End If
    103. '.Cells(i, 3) = OVSht.Cells(j, "T") 'Auftragsnr.
    104. '.Cells(i, 4) = OVSht.Cells(j, "R") 'Land
    105. '.Cells(i, 6) = OVSht.Cells(j, "S") 'Kunden Name
    106. '.Cells(i, 7) = OVSht.Cells(j, "Y") 'Fertigstellung
    107. '.Cells(i, 8) = OVSht.Cells(j, "AB") 'Abholung
    109. ElseIf Trim(OVSht.Cells(j, "Q")) = "HMMI" Then
    110. If Trim(.Cells(i, "C")) <> Trim(OVSht.Cells(j, "T")) Then
    111. .Cells(i, 3) = OVSht.Cells(j, "T") 'Auftragsnr.
    112. .Cells(i, 16) = 1 'Meistertask Status
    113. 'Auftragsnummer vergleichen ENDE
    114. End If
    115. If Trim(.Cells(i, "D")) <> Trim(OVSht.Cells(j, "R")) Then
    116. .Cells(i, 4) = OVSht.Cells(j, "R") 'Land
    117. .Cells(i, 16) = 1 'Meistertask Status
    118. End If
    119. If Trim(.Cells(i, "D")) <> Trim(OVSht.Cells(j, "S")) Then
    120. .Cells(i, 6) = OVSht.Cells(j, "S") 'Kunden Name
    121. .Cells(i, 16) = 1 'Meistertask Status
    122. End If
    123. If Trim(.Cells(i, "D")) <> Trim(OVSht.Cells(j, "Y")) Then
    124. .Cells(i, 7) = OVSht.Cells(j, "Y") 'Fertigstellung
    125. .Cells(i, 16) = 1 'Meistertask Status
    126. End If
    127. If Trim(.Cells(i, "D")) <> Trim(OVSht.Cells(j, "AB")) Then
    128. .Cells(i, 8) = OVSht.Cells(j, "AB") 'Abholung
    129. .Cells(i, 16) = 1 'Meistertask Status
    130. End If
    131. '** Kunde aus Spalte U oder W nehmen??
    132. ' .Cells(i, 3) = OVSht.Cells(j, "T") 'Auftragsnr.
    133. ' .Cells(i, 4) = OVSht.Cells(j, "R") 'Land
    134. ' .Cells(i, 6) = OVSht.Cells(j, "S") 'Kunden Name
    135. ' .Cells(i, 7) = OVSht.Cells(j, "Y") 'Fertigstellung
    136. ' .Cells(i, 8) = OVSht.Cells(j, "AB") 'Abholung
    138. Else
    140. If Trim(.Cells(i, "C")) <> Trim(OVSht.Cells(j, "T")) Then
    141. .Cells(i, 3) = OVSht.Cells(j, "T") 'Auftragsnr.
    142. .Cells(i, 16) = 1 'Meistertask Status
    143. 'Auftragsnummer vergleichen ENDE
    144. End If
    145. If Trim(.Cells(i, "D")) <> Trim(OVSht.Cells(j, "R")) Then
    146. .Cells(i, 4) = OVSht.Cells(j, "R") 'Land
    147. .Cells(i, 16) = 1 'Meistertask Status
    148. End If
    149. If Trim(.Cells(i, "D")) <> Trim(OVSht.Cells(j, "Q")) Then
    150. .Cells(i, 6) = OVSht.Cells(j, "Q") 'Kunden Name
    151. .Cells(i, 16) = 1 'Meistertask Status
    152. End If
    153. If Trim(.Cells(i, "D")) <> Trim(OVSht.Cells(j, "Y")) Then
    154. .Cells(i, 7) = OVSht.Cells(j, "Y") 'Fertigstellung
    155. .Cells(i, 16) = 1 'Meistertask Status
    156. End If
    157. If Trim(.Cells(i, "D")) <> Trim(OVSht.Cells(j, "AB")) Then
    158. .Cells(i, 8) = OVSht.Cells(j, "AB") 'Abholung
    159. .Cells(i, 16) = 1 'Meistertask Status
    160. End If
    161. '.Cells(i, 3) = OVSht.Cells(j, "T") 'Auftragsnr.
    162. '.Cells(i, 4) = OVSht.Cells(j, "R") 'Land
    163. '.Cells(i, 6) = OVSht.Cells(j, "Q") 'Kunden Name
    164. '.Cells(i, 7) = OVSht.Cells(j, "Y") 'Fertigstellung
    165. '.Cells(i, 8) = OVSht.Cells(j, "AB") 'Abholung
    166. End If
    167. End If
    168. 'Da wir die Exceltabelle und die Userform gleichzeitig bearbeitet werden
    169. ' müssen wir einen eine Aufgabe in den Arbeitsspeicher auslagern.
    170. 'Ansonsten sehen wir zur Laufzeit keine Veränderungen an der Progressbar.
    171. 'Um dies zu realisieren übergeben wir die Ermittlung der Wochentage mit
    172. '"Do Events" an den Arbeitspeicher.
    173. DoEvents
    174. 'Um den aktuellen Fortschritt anzeigen zu können ermitteln wir
    175. 'als nächstes anhand unseres Zählers und der letzten Zeile den
    176. 'prozentualen Wert. -1 da wir in der 2. Zeile beginnen.
    177. ProzentAktuell = (i - MZ1) / (lrML - MZ1) * 100
    178. 'Unser Prozentlabel hat eine Länge (width) von 500. Wir teilen
    179. 'diese durch 100 und multiplizieren das Ergebnis mit den zuvor
    180. 'ermittelten Fortschritt. Anschließend können wir unsere Elemente
    181. 'mit diesem Ergebnis exakt positionieren.
    182. ProzentLänge = 500 / 100 * ProzentAktuell
    183. 'Nun zeigen wir unserem User den aktuellen Fortschritt
    184. Prozentanzeige.Caption = Format(ProzentAktuell, "##0") & " %"
    185. 'Außerdem interessiert dem User die aktuelle Position unserer Tabelle
    186. Zeile.Caption = "Zeile " & i & " von " & lrML & " Zeilen bearbeitet "
    187. 'Die Breite unseres Fortschrittbalkens wird um die Prozentlänge erhöht.
    188. Fortschritt.Width = ProzentLänge
    189. 'Hier zeigen wir das aktuelle Datum sowie den ermittelten Tag
    190. aktuellesDatum.Caption = .Cells(i, 1) & "/" & .Cells(i, 2) & " - " & .Cells(i, 3)
    191. 'Die linke Position unserer Prozentanzeige, die "Mitfährt", wird durch die
    192. 'steigende Breite des Fortschrittbalkens nach links verschoben.
    193. '-47 da dies die Breite des Labels ist.
    194. Prozentanzeige.Left = Fortschritt.Width - 47
    195. 'Abhängig vom prozentualen Fortschritt manipulieren wir nun die Farbe unseres
    196. 'Fortschrittslabels und ändern die Caption unserer Userform entsprechend.
    197. Select Case ProzentAktuell
    198. Case Is > 85
    199. 'Me.Caption = "Ich bin gleich fertig"
    200. Fortschritt.BackColor = vbGreen
    201. Case Is < 50
    202. 'Me.Caption = "Es dauert noch eine Weile"
    203. Fortschritt.BackColor = vbRed
    204. Case Is > 49
    205. Fortschritt.BackColor = vbYellow
    206. 'Me.Caption = "Mehr als die Hälfte ist geschafft"
    207. End Select
    208. Next j
    209. Next i
    210. End With
    211. 'Um unser Ergebnis anzuzeigen schalten wir zuletzt die Bildschirmaktualisierung wieder
    212. 'ein
    213. Application.ScreenUpdating = True
    214. 'MsgBox n & " Maschinen aus der Liste sind in den Produktionshallen."
    215. 'Endzeit in Label schreiben
    216. Set Plan = Nothing
    217. Set Liste = Nothing
    218. Me.Label39.Caption = CDate(Time - DaZeit)
    219. Me.Label35.Caption = Time
    220. Application.StatusBar = OldTxt
    221. 'Ergebnis in Labels schreiben
    222. Me.Label37.Caption = " Maschinen wurden abgeglichen"
    223. Me.Label38.Caption = "Viel Spaß beim arbeiten :)"
    224. 'Button deaktivieren
    225. CommandButton1.Enabled = True
    226. Exit Sub
    227. FehlerVerarbeitung:
    228. 'Was tun, wenn ein Laufzeitfehler auftritt?
    229. MsgBox "Fehler aufgetreten, Programm beenden"
    230. 'Fehler: MsgBox "Unerwarteter Fehler - Richtige Datei mit richtigem Blatt geöffnet ??"
    231. Fehler: MsgBox " Datei: " & AbgDatei & " - Blatt: " & Deliver1 & Chr(10) & "Datei geöffnet? und/oder Name richtig geschrieben??" & Chr(10), vbOKOnly, " Fehler bitte prüfen " '& Error()
    232. CommandButton1.Enabled = True
    233. End Sub
    234. Private Sub Image1_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
    235. End Sub
    237. Private Sub Label38_Click()
    239. End Sub
    241. 'Zentrieren auf beiden Bildschirmen des Fenstern
    242. Private Sub UserForm_Initialize()
    243. Dim sngTop As Single, sngLeft As Single
    244. Me.StartUpPosition = 0
    245. sngLeft = Application.Left + Application.Width / 2 - Me.Width / 2
    246. sngTop = Application.Top + Application.Height / 2 - Me.Height / 2
    247. Me.Left = sngLeft
    248. Me.Top = sngTop
    249. Label13 = Date
    250. Label28 = Time
    251. End Sub



    aufgrund des Codeumfangs Spoiler hinzugefügt und CodeTags korrigiert ~VaporiZed

    Dieser Beitrag wurde bereits 3 mal editiert, zuletzt von „VaporiZed“ ()

    Also syntaktisch haut das schon mal absolut gar nicht hin. Schau dir noch mal an, wie man denn so eine Abfrage mit if + elseif + end if richtig schreibt und dann vergleiche das dann mal mit denen in deinem Code.
    Womit du aber recht hast, da wo die Erste Bedingung zutrifft wird der Code ausgeführt, alle anderen nicht.

    Womit entwickelst du denn, Text-Editor? Ich hab NULL Ahnung von Excel, da wird es doch sicher eine IDE geben, nutze eine, dann sollten dir so einige Fehler angezeigt werden.


    Visual Basic-Quellcode

    1. If Trim(.Cells(i, "C")) <> Trim(OVSht.Cells(j, "T")) Then
    3. Else If '############################ else if was? das in der nächsten Zeile? Syntax ERROR!
    4. If Trim(.Cells(i, "D")) <> Trim(OVSht.Cells(j, "R")) Then
    6. Else If
    7. .......


    PS.
    @VaporiZed
    Erledigt, war mir nicht sicher welcher der richtige ist.

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „BitBrösel“ ()

    Tja, wie wär's mit Haltepunkten?
    Einfach immer dann, wenn .Cells(i, 16) = 1 kommt, noch ein Stop dazu, dann weißt Du, an welcher Stelle die Methode einen Unterschied sieht.
    Oder es geht auch etwas effizienter: Zu Methodenbeginn: Dim Unterschiedstext As String und immer, wenn der Status auf 1 gesetzt wird, dann Unterschiedstext = Unterschiedstext & hierEinenCodestellenspezifischenHinweisWasDaGeradeAndersIst & "; " und am Ende der Methode: MsgBox Unterschiedstext

    @BitBrösel: Korrigier Du bitte Deine CodeTags selber von VB.NET auf VB ;)
    Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von „VaporiZed“, mal wieder aus Grammatikgründen.

    Aufgrund spontaner Selbsteintrübung sind all meine Glaskugeln beim Hersteller. Lasst mich daher bitte nicht den Spekulatiusbackmodus wechseln.

    Ich habe meine Lösung mal aktualisiert.
    Habe hier das Problem er macht immer eine 1.

    Er gleicht ja Zeilen mit Zeilen aus einer anderen Datei ab und wenn er in einer der 5 Spalten einen Unterschied findet und diesen dann anpasst soll bei dieser Zeile in Spalte P eine 1 rein. Habe dort eine bedingte Formatierung drin und mit 1 ein ! dann darin.

    Sprich das wäre mein Ziel guck dir die Zeilen alle an ist etwas unterschiedlich darin passe dies an und schreibe in P eine 1.

    Nu mal langsam. Was ist jetzt gerade aktuell das Ziel/Problem? Ich dachte, das Problem, was es jetzt zu lösen gilt, ist, dass immer eine 1, also ein Unterschied registriert wird, obwohl kein Unterschied da zu sein scheint. Ist das jetzt Dein Anliegen oder nicht?
    Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von „VaporiZed“, mal wieder aus Grammatikgründen.

    Aufgrund spontaner Selbsteintrübung sind all meine Glaskugeln beim Hersteller. Lasst mich daher bitte nicht den Spekulatiusbackmodus wechseln.

    Hallo,

    ja das ist mein Anliegen des Codes in meinem Post der "Lösung"

    Ich bin mir nicht sicher ob <> dafür steht das diese Unterschiedlich sind.
    Denn aktuell hab ich sie schon abgeglichen und meine Zeilenwerte sind gleich trotzdem bekomme ich in Spalte P bei jeder Zeile eine 1

    Dann lass Dir doch einfach mal ganz konkret die Werte der beiden Zellen anzeigen. Und poste sie mal, vielleicht erkennen wir einen Unterschied. Und BitBrösels Syntaxfrage ist noch offen.
    Und bitte: Entweder korrekt Kommas setzen oder kurze Sätze schreiben. Deine Posts sind inhaltlich ziemlich unklar.
    Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von „VaporiZed“, mal wieder aus Grammatikgründen.

    Aufgrund spontaner Selbsteintrübung sind all meine Glaskugeln beim Hersteller. Lasst mich daher bitte nicht den Spekulatiusbackmodus wechseln.

    Wenn das in Excel klappt …
    Aber Du scheinst ein UserForm zu haben. Dann kannst Du doch ne ListBox draufhauen und immer wenn es Unterschiede gibt, dann mit AddItem die Werte der beiden Zellen hinzufügen. Und wenn Du zwei scheinbar gleiche Sheets hast, kannst Du dann eben schnell(er) erkennen, wo die Unterschiede sind.
    Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von „VaporiZed“, mal wieder aus Grammatikgründen.

    Aufgrund spontaner Selbsteintrübung sind all meine Glaskugeln beim Hersteller. Lasst mich daher bitte nicht den Spekulatiusbackmodus wechseln.

    Vielen Dank.
    Durch den Tipp habe ich mich etwas mit dem Debug.Print beschäftigt und alle Werte ausgegeben.

    Dabei ist mir ein Fehler im Code aufgefallen. Es funktioniert nun wie es soll.

    Anbei die Lösung:
    Spoiler anzeigen

    Visual Basic-Quellcode

    1. 'Option Explicit
    2. Const MZ1 = 11 '1.Zeile in Maschinenliste wahlweise 19 oder 22
    3. Const MLZ1 = 2 '1.Zeile in MASTER Liste wahlweise 19 oder 22
    4. Private Sub CommandButton1_Click()
    5. MitKommentar
    6. End Sub
    7. Private Sub MitKommentar()
    8. 'Als erste deklarieren wir unsere Variablen
    9. 'Den Zähler i für die aktuelle Zeile
    10. 'Dim i As Long
    11. 'Die letzte Zeile
    12. 'Dim lzML As Long
    13. 'Variablen um die prozentualen Anteil zu ermitteln
    14. Dim Prozent As Double
    15. Dim ProzentAktuell As Double
    16. Dim ProzentLänge As Double
    17. 'Berechnung Dauer des Vorgangs
    18. Dim DaZeit As Date
    19. DaZeit = Time
    21. 'Die Berechnung
    22. Dim i As Integer, j As Integer
    23. Dim lrOV As Long, lrML As Long
    25. On Error GoTo Fehler
    26. 'Fehlermeldungssetzung
    27. AbgDatei = ThisWorkbook.Sheets("Maschinenliste").Range("G8").Value
    28. Deliver1 = ThisWorkbook.Sheets("Maschinenliste").Range("G9").Value
    29. 'Ende
    31. 'Dim Plan As Workbook: Set Plan = Workbooks("MASTER HTIG PRODUCTION 2022.xlsx")
    32. Dim Plan As Workbook:
    33. Set Plan = Workbooks(ThisWorkbook.Sheets("Maschinenliste").Range("G8").Value)
    35. 'MsgBox Plan.Value
    38. Dim Liste As Workbook:
    40. Set Liste = Workbooks("QC Maschinenliste.xlsm")
    41. 'Dim OVSht As Worksheet: Set OVSht = Plan.Sheets("Overview Machines")
    43. On Error GoTo Fehler
    46. Dim OVSht As Worksheet
    48. Set OVSht = Plan.Worksheets(ThisWorkbook.Sheets("Maschinenliste").Range("G9").Value)
    50. 'Button deaktivieren
    51. CommandButton1.Enabled = False
    52. 'Zu Fehler springen wenn Blatt/Datei Falsch
    53. On Error GoTo Fehler
    54. 'Set Wb = Workbooks(AbgDatei)
    55. 'Set DEL = Wb.Worksheets(Deliver1)
    56. 'lzDV = DEL.Cells(Rows.Count, 1).End(xlUp).Row
    57. 'Startzeit in Label schreiben
    58. Me.Label34.Caption = Time
    59. 'Andere Label leeren
    60. Me.Label35.Caption = ""
    61. Me.Label37.Caption = ""
    62. Me.Label38.Caption = ""
    63. 'Statusbar alten Text speichern
    64. OldTxt = Application.StatusBar
    65. 'Um das ganze ein wenig zu beschleunigen schalten wir vorübergehend
    66. 'die Bildschirmaktualisierung aus
    67. Application.ScreenUpdating = False
    68. 'Als erstes setzen wir die Variable Prozent auf null
    69. Prozent = 0
    70. With Liste.Sheets("Maschinenliste")
    71. lrML = .Cells(Rows.Count, 3).End(xlUp).Row
    72. lrOV = OVSht.Cells(Rows.Count, 6).End(xlUp).Row
    73. '1.Schleife in Maschinenliste
    74. For i = MZ1 To lrML
    75. '2.Schleife in Overview Sheet
    76. For j = MLZ1 To lrOV
    77. 'in Overview nach Maschinen-Nr. suchen
    78. If Trim(.Cells(i, "B")) = Trim(OVSht.Cells(j, "D")) Then
    80. 'Daten laden wenn alle Zellen Werte haben
    81. 'If Trim(OVSht.Cells(j, "Q")) <> "" Then
    83. If Trim(OVSht.Cells(j, "Q")) = "HTIG" Then
    84. '** Kunde aus Spalte U oder W nehmen??
    85. 'Aufragsnummer vergleichen START
    86. If Trim(.Cells(i, "C")) <> Trim(OVSht.Cells(j, "T")) Then
    87. .Cells(i, 3) = OVSht.Cells(j, "T") 'Auftragsnr.
    88. .Cells(i, 16) = 1 'Meistertask Status
    89. 'Auftragsnummer vergleichen ENDE
    90. End If
    91. If Trim(.Cells(i, "D")) <> Trim(OVSht.Cells(j, "R")) Then
    92. .Cells(i, 4) = OVSht.Cells(j, "R") 'Land
    93. .Cells(i, 16) = 1 'Meistertask Status
    94. End If
    95. If Trim(.Cells(i, "F")) <> Trim(OVSht.Cells(j, "S")) Then
    96. .Cells(i, 6) = OVSht.Cells(j, "S") 'Kunden Name
    97. .Cells(i, 16) = 1 'Meistertask Status
    98. End If
    99. If Trim(.Cells(i, "G")) <> Trim(OVSht.Cells(j, "Y")) Then
    100. .Cells(i, 7) = OVSht.Cells(j, "Y") 'Fertigstellung
    101. .Cells(i, 16) = 1 'Meistertask Status
    102. End If
    103. If Trim(.Cells(i, "H")) <> Trim(OVSht.Cells(j, "AB")) Then
    104. .Cells(i, 8) = OVSht.Cells(j, "AB") 'Abholung
    105. .Cells(i, 16) = 1 'Meistertask Status
    106. End If
    108. '.Cells(i, 3) = OVSht.Cells(j, "T") 'Auftragsnr.
    109. '.Cells(i, 4) = OVSht.Cells(j, "R") 'Land
    110. '.Cells(i, 6) = OVSht.Cells(j, "S") 'Kunden Name
    111. '.Cells(i, 7) = OVSht.Cells(j, "Y") 'Fertigstellung
    112. '.Cells(i, 8) = OVSht.Cells(j, "AB") 'Abholung
    114. ElseIf Trim(OVSht.Cells(j, "Q")) = "HMMI" Then
    115. If Trim(.Cells(i, "C")) <> Trim(OVSht.Cells(j, "T")) Then
    116. .Cells(i, 3) = OVSht.Cells(j, "T") 'Auftragsnr.
    117. .Cells(i, 16) = 1 'Meistertask Status
    118. 'Auftragsnummer vergleichen ENDE
    119. End If
    120. If Trim(.Cells(i, "D")) <> Trim(OVSht.Cells(j, "R")) Then
    121. .Cells(i, 4) = OVSht.Cells(j, "R") 'Land
    122. .Cells(i, 16) = 1 'Meistertask Status
    123. End If
    124. If Trim(.Cells(i, "F")) <> Trim(OVSht.Cells(j, "S")) Then
    125. .Cells(i, 6) = OVSht.Cells(j, "S") 'Kunden Name
    126. .Cells(i, 16) = 1 'Meistertask Status
    127. End If
    128. If Trim(.Cells(i, "G")) <> Trim(OVSht.Cells(j, "Y")) Then
    129. .Cells(i, 7) = OVSht.Cells(j, "Y") 'Fertigstellung
    130. .Cells(i, 16) = 1 'Meistertask Status
    131. End If
    132. If Trim(.Cells(i, "H")) <> Trim(OVSht.Cells(j, "AB")) Then
    133. .Cells(i, 8) = OVSht.Cells(j, "AB") 'Abholung
    134. .Cells(i, 16) = 1 'Meistertask Status
    135. End If
    136. '** Kunde aus Spalte U oder W nehmen??
    137. ' .Cells(i, 3) = OVSht.Cells(j, "T") 'Auftragsnr.
    138. ' .Cells(i, 4) = OVSht.Cells(j, "R") 'Land
    139. ' .Cells(i, 6) = OVSht.Cells(j, "S") 'Kunden Name
    140. ' .Cells(i, 7) = OVSht.Cells(j, "Y") 'Fertigstellung
    141. ' .Cells(i, 8) = OVSht.Cells(j, "AB") 'Abholung
    143. Else
    145. If Trim(.Cells(i, "C")) <> Trim(OVSht.Cells(j, "T")) Then
    146. .Cells(i, 3) = OVSht.Cells(j, "T") 'Auftragsnr.
    147. .Cells(i, 16) = 1 'Meistertask Status
    148. 'Auftragsnummer vergleichen ENDE
    149. End If
    150. If Trim(.Cells(i, "D")) <> Trim(OVSht.Cells(j, "R")) Then
    151. .Cells(i, 4) = OVSht.Cells(j, "R") 'Land
    152. .Cells(i, 16) = 1 'Meistertask Status
    153. End If
    154. If Trim(.Cells(i, "F")) <> Trim(OVSht.Cells(j, "Q")) Then
    155. .Cells(i, 6) = OVSht.Cells(j, "Q") 'Kunden Name
    156. .Cells(i, 16) = 1 'Meistertask Status
    157. End If
    158. If Trim(.Cells(i, "G")) <> Trim(OVSht.Cells(j, "Y")) Then
    159. .Cells(i, 7) = OVSht.Cells(j, "Y") 'Fertigstellung
    160. .Cells(i, 16) = 1 'Meistertask Status
    161. End If
    162. If Trim(.Cells(i, "H")) <> Trim(OVSht.Cells(j, "AB")) Then
    163. .Cells(i, 8) = OVSht.Cells(j, "AB") 'Abholung
    164. .Cells(i, 16) = 1 'Meistertask Status
    165. End If
    166. '.Cells(i, 3) = OVSht.Cells(j, "T") 'Auftragsnr.
    167. '.Cells(i, 4) = OVSht.Cells(j, "R") 'Land
    168. '.Cells(i, 6) = OVSht.Cells(j, "Q") 'Kunden Name
    169. '.Cells(i, 7) = OVSht.Cells(j, "Y") 'Fertigstellung
    170. '.Cells(i, 8) = OVSht.Cells(j, "AB") 'Abholung
    171. End If
    172. End If
    173. 'Da wir die Exceltabelle und die Userform gleichzeitig bearbeitet werden
    174. ' müssen wir einen eine Aufgabe in den Arbeitsspeicher auslagern.
    175. 'Ansonsten sehen wir zur Laufzeit keine Veränderungen an der Progressbar.
    176. 'Um dies zu realisieren übergeben wir die Ermittlung der Wochentage mit
    177. '"Do Events" an den Arbeitspeicher.
    178. DoEvents
    179. 'Um den aktuellen Fortschritt anzeigen zu können ermitteln wir
    180. 'als nächstes anhand unseres Zählers und der letzten Zeile den
    181. 'prozentualen Wert. -1 da wir in der 2. Zeile beginnen.
    182. ProzentAktuell = (i - MZ1) / (lrML - MZ1) * 100
    183. 'Unser Prozentlabel hat eine Länge (width) von 500. Wir teilen
    184. 'diese durch 100 und multiplizieren das Ergebnis mit den zuvor
    185. 'ermittelten Fortschritt. Anschließend können wir unsere Elemente
    186. 'mit diesem Ergebnis exakt positionieren.
    187. ProzentLänge = 500 / 100 * ProzentAktuell
    188. 'Nun zeigen wir unserem User den aktuellen Fortschritt
    189. Prozentanzeige.Caption = Format(ProzentAktuell, "##0") & " %"
    190. 'Außerdem interessiert dem User die aktuelle Position unserer Tabelle
    191. Zeile.Caption = "Zeile " & i & " von " & lrML & " Zeilen bearbeitet "
    192. 'Die Breite unseres Fortschrittbalkens wird um die Prozentlänge erhöht.
    193. Fortschritt.Width = ProzentLänge
    194. 'Hier zeigen wir das aktuelle Datum sowie den ermittelten Tag
    195. aktuellesDatum.Caption = .Cells(i, 1) & "/" & .Cells(i, 2) & " - " & .Cells(i, 3)
    196. 'Die linke Position unserer Prozentanzeige, die "Mitfährt", wird durch die
    197. 'steigende Breite des Fortschrittbalkens nach links verschoben.
    198. '-47 da dies die Breite des Labels ist.
    199. Prozentanzeige.Left = Fortschritt.Width - 47
    200. 'Abhängig vom prozentualen Fortschritt manipulieren wir nun die Farbe unseres
    201. 'Fortschrittslabels und ändern die Caption unserer Userform entsprechend.
    202. Select Case ProzentAktuell
    203. Case Is > 85
    204. 'Me.Caption = "Ich bin gleich fertig"
    205. Fortschritt.BackColor = vbGreen
    206. Case Is < 50
    207. 'Me.Caption = "Es dauert noch eine Weile"
    208. Fortschritt.BackColor = vbRed
    209. Case Is > 49
    210. Fortschritt.BackColor = vbYellow
    211. 'Me.Caption = "Mehr als die Hälfte ist geschafft"
    212. End Select
    213. Next j
    214. Next i
    215. End With
    216. 'Um unser Ergebnis anzuzeigen schalten wir zuletzt die Bildschirmaktualisierung wieder
    217. 'ein
    218. Application.ScreenUpdating = True
    219. 'MsgBox n & " Maschinen aus der Liste sind in den Produktionshallen."
    220. 'Endzeit in Label schreiben
    221. Set Plan = Nothing
    222. Set Liste = Nothing
    223. Me.Label39.Caption = CDate(Time - DaZeit)
    224. Me.Label35.Caption = Time
    225. Application.StatusBar = OldTxt
    226. 'Ergebnis in Labels schreiben
    227. Me.Label37.Caption = " Maschinen wurden abgeglichen"
    228. Me.Label38.Caption = "Viel Spaß beim arbeiten :)"
    229. 'Button deaktivieren
    230. CommandButton1.Enabled = True
    231. Exit Sub
    232. FehlerVerarbeitung:
    233. 'Was tun, wenn ein Laufzeitfehler auftritt?
    234. MsgBox "Fehler aufgetreten, Programm beenden"
    235. 'Fehler: MsgBox "Unerwarteter Fehler - Richtige Datei mit richtigem Blatt geöffnet ??"
    236. Fehler: MsgBox " Datei: " & AbgDatei & " - Blatt: " & Deliver1 & Chr(10) & "Datei geöffnet? und/oder Name richtig geschrieben??" & Chr(10), vbOKOnly, " Fehler bitte prüfen " '& Error()
    237. CommandButton1.Enabled = True
    238. End Sub
    239. Private Sub Image1_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
    240. End Sub
    242. Private Sub Label37_Click()
    244. End Sub
    246. Private Sub Label38_Click()
    247. End Sub
    248. 'Zentrieren auf beiden Bildschirmen des Fenstern
    249. Private Sub UserForm_Initialize()
    250. Dim sngTop As Single, sngLeft As Single
    251. Me.StartUpPosition = 0
    252. sngLeft = Application.Left + Application.Width / 2 - Me.Width / 2
    253. sngTop = Application.Top + Application.Height / 2 - Me.Height / 2
    254. Me.Left = sngLeft
    255. Me.Top = sngTop
    256. Label13 = Date
    257. Label28 = Time
    258. End Sub


Facebook
Telefonspende