Daten aus andere Datei vergleichen und wenn nicht verfügbar in Masterdatei einfügen

  • Excel

Es gibt 3 Antworten in diesem Thema. Der letzte Beitrag () ist von Panter.

    Daten aus andere Datei vergleichen und wenn nicht verfügbar in Masterdatei einfügen

    Hallo zusammen,

    und zwar stehe ich gerade vor folgender Aufgabe:

    - Ich gleiche Maschinendaten aus einer anderen Datei ab und wenn diese in meiner Liste fehlen werden Daten aus der anderen Liste eingetragen.

    Mein Problem ist:

    - Er fügt immer wieder auch Maschinen ein, welche schon vorhanden sind. Trotz Abfrage von (If IsError(Application.Match(.Cells(lngZeile, 4), _
    wksZiel.Columns(2), 0)) Then) als nur wenn die Seriennummer nicht vorhanden ist aus der Quelle Spalte 4 (D) in das Ziel von da aus wo meine Daten sind Spalte 2 (B)


    Anbei der Code mit der Hoffnung um Hilfe:

    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
    37. Dim Liste As Workbook:
    39. Set Liste = Workbooks("QC Maschinenliste.xlsm")
    40. 'Dim OVSht As Worksheet: Set OVSht = Plan.Sheets("Overview Machines")
    42. On Error GoTo Fehler
    44. Dim OVSht As Worksheet
    46. Set OVSht = Plan.Worksheets(ThisWorkbook.Sheets("Maschinenliste").Range("G9").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
    55. 'Startzeit in Label schreiben
    56. Me.Label34.Caption = Time
    57. 'Andere Label leeren
    58. Me.Label35.Caption = ""
    59. Me.Label37.Caption = ""
    60. Me.Label38.Caption = ""
    61. 'Statusbar alten Text speichern
    62. OldTxt = Application.StatusBar
    63. 'Um das ganze ein wenig zu beschleunigen schalten wir vorübergehend
    64. 'die Bildschirmaktualisierung aus
    65. Application.ScreenUpdating = False
    66. 'Als erstes setzen wir die Variable Prozent auf null
    67. Prozent = 0
    68. Dim lngZeile As Long
    69. 'Dim lngLetzteQuelle As Long
    70. Dim lngLetzteZiel As Long
    71. 'Dim wksQuelle As Worksheet
    72. Dim wksZiel As Worksheet
    73. 'Set wksQuelle = OVSht ' Quelltabelle, Spalte A
    74. Set wksZiel = Liste.Sheets("Maschinenliste") ' Zieltabelle, Spalte J
    75. ' bezogen auf Tabelle1
    76. With OVSht
    77. ' letzte belegte Zeile in Spalte J
    78. lngLetzteQuelle = IIf(IsEmpty(.Cells(.Rows.Count, 1)), _
    79. .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
    80. ' Schleife von 2 bis zur letzten belegten Zeile
    81. For lngZeile = 2 To lngLetzteQuelle
    82. ' VERGLEICH laufende Zeile Spalte D Quelltabelle mit Spalte B Zieltabelle
    83. ' Eintrag nicht gefunden
    84. If IsError(Application.Match(.Cells(lngZeile, 4), _
    85. wksZiel.Columns(2), 0)) Then
    86. ' letzte belegte Zeile in Zieltabelle ermitteln
    87. lngLetzteZiel = IIf(IsEmpty(wksZiel.Cells(wksZiel.Rows.Count, 1)), _
    88. wksZiel.Cells(wksZiel.Rows.Count, 1).End(xlUp).Row, wksZiel.Rows.Count)
    89. ' in erste freie Zeile in Zieltabelle eintragen
    90. If Trim(.Cells(lngZeile, "P")) = Trim("Yes") Then
    91. If Trim(.Cells(lngZeile, "I")) = Trim("cif Hamburg") Then
    92. If Trim(.Cells(lngZeile, "Q")) = "HTIG" Then
    93. wksZiel.Cells(lngLetzteZiel + 1, 1) = .Cells(lngZeile, 1) & " " & .Cells(lngZeile, 2) & " " & .Cells(lngZeile, 3) 'Maschinendaten
    94. wksZiel.Cells(lngLetzteZiel + 1, 2) = "'" & .Cells(lngZeile, 4) 'Seriennummer
    95. wksZiel.Cells(lngLetzteZiel + 1, 3) = .Cells(lngZeile, 20) ' Auftragsnummer
    96. wksZiel.Cells(lngLetzteZiel + 1, 4) = .Cells(lngZeile, 18) ' Land
    97. wksZiel.Cells(lngLetzteZiel + 1, 6) = .Cells(lngZeile, 19) 'Kunde
    98. wksZiel.Cells(lngLetzteZiel + 1, 7) = .Cells(lngZeile, 24) ' Prod Fertig
    99. wksZiel.Cells(lngLetzteZiel + 1, 8) = .Cells(lngZeile, 23) ' Abholtermin
    101. 'Status setzen
    102. wksZiel.Cells(lngLetzteZiel + 1, 11) = "0"
    103. wksZiel.Cells(lngLetzteZiel + 1, 16) = "0"
    105. ' ElseIf Trim(.Cells(lngZeile, "Q")) = "HMMI" Then
    106. ' wksZiel.Cells(lngLetzteZiel + 1, 1) = .Cells(lngZeile, 1) & " " & .Cells(lngZeile, 2) & " " & .Cells(lngZeile, 3)
    107. ' wksZiel.Cells(lngLetzteZiel + 1, 2) = "'" & .Cells(lngZeile, 4)
    108. ' wksZiel.Cells(lngLetzteZiel + 1, 3) = .Cells(lngZeile, 20)
    109. ' wksZiel.Cells(lngLetzteZiel + 1, 4) = .Cells(lngZeile, 18)
    110. ' wksZiel.Cells(lngLetzteZiel + 1, 6) = .Cells(lngZeile, 19)
    111. ' wksZiel.Cells(lngLetzteZiel + 1, 7) = .Cells(lngZeile, 24)
    112. ' wksZiel.Cells(lngLetzteZiel + 1, 8) = .Cells(lngZeile, 23)
    113. '
    114. ' 'Status setzen
    115. ' wksZiel.Cells(lngLetzteZiel + 1, 11) = "0"
    116. ' wksZiel.Cells(lngLetzteZiel + 1, 16) = "0"
    118. Else
    119. wksZiel.Cells(lngLetzteZiel + 1, 1) = .Cells(lngZeile, 1) & " " & .Cells(lngZeile, 2) & " " & .Cells(lngZeile, 3)
    120. wksZiel.Cells(lngLetzteZiel + 1, 2) = "'" & .Cells(lngZeile, 4)
    121. wksZiel.Cells(lngLetzteZiel + 1, 3) = .Cells(lngZeile, 20)
    122. wksZiel.Cells(lngLetzteZiel + 1, 4) = .Cells(lngZeile, 18)
    123. wksZiel.Cells(lngLetzteZiel + 1, 6) = .Cells(lngZeile, 17)
    124. wksZiel.Cells(lngLetzteZiel + 1, 7) = .Cells(lngZeile, 24)
    125. wksZiel.Cells(lngLetzteZiel + 1, 8) = .Cells(lngZeile, 23)
    127. 'Status setzen
    128. wksZiel.Cells(lngLetzteZiel + 1, 11) = "0"
    129. wksZiel.Cells(lngLetzteZiel + 1, 16) = "0"
    130. End If
    131. End If
    132. End If
    133. End If
    136. 'Da wir die Exceltabelle und die Userform gleichzeitig bearbeitet werden
    137. ' müssen wir einen eine Aufgabe in den Arbeitsspeicher auslagern.
    138. 'Ansonsten sehen wir zur Laufzeit keine Veränderungen an der Progressbar.
    139. 'Um dies zu realisieren übergeben wir die Ermittlung der Wochentage mit
    140. '"Do Events" an den Arbeitspeicher.
    141. DoEvents
    142. 'Um den aktuellen Fortschritt anzeigen zu können ermitteln wir
    143. 'als nächstes anhand unseres Zählers und der letzten Zeile den
    144. 'prozentualen Wert. -1 da wir in der 2. Zeile beginnen.
    145. ProzentAktuell = (lngZeile - MLZ1) / (lngLetzteQuelle - MLZ1) * 100
    146. 'Unser Prozentlabel hat eine Länge (width) von 500. Wir teilen
    147. 'diese durch 100 und multiplizieren das Ergebnis mit den zuvor
    148. 'ermittelten Fortschritt. Anschließend können wir unsere Elemente
    149. 'mit diesem Ergebnis exakt positionieren.
    150. ProzentLänge = 500 / 100 * ProzentAktuell
    151. 'Nun zeigen wir unserem User den aktuellen Fortschritt
    152. Prozentanzeige.Caption = Format(ProzentAktuell, "##0") & " %"
    153. 'Außerdem interessiert dem User die aktuelle Position unserer Tabelle
    154. Zeile.Caption = "Zeile " & lngZeile & " von " & lngLetzteQuelle & " Zeilen bearbeitet "
    155. 'Die Breite unseres Fortschrittbalkens wird um die Prozentlänge erhöht.
    156. Fortschritt.Width = ProzentLänge
    157. 'Hier zeigen wir das aktuelle Datum sowie den ermittelten Tag
    158. aktuellesDatum.Caption = .Cells(lngZeile, 1) & "/" & .Cells(lngZeile, 2) & " - " & .Cells(lngZeile, 3)
    159. 'Die linke Position unserer Prozentanzeige, die "Mitfährt", wird durch die
    160. 'steigende Breite des Fortschrittbalkens nach links verschoben.
    161. '-47 da dies die Breite des Labels ist.
    162. Prozentanzeige.Left = Fortschritt.Width - 47
    163. 'Abhängig vom prozentualen Fortschritt manipulieren wir nun die Farbe unseres
    164. 'Fortschrittslabels und ändern die Caption unserer Userform entsprechend.
    165. Select Case ProzentAktuell
    166. Case Is > 85
    167. 'Me.Caption = "Ich bin gleich fertig"
    168. Fortschritt.BackColor = vbGreen
    169. Case Is < 50
    170. 'Me.Caption = "Es dauert noch eine Weile"
    171. Fortschritt.BackColor = vbRed
    172. Case Is > 49
    173. Fortschritt.BackColor = vbYellow
    174. 'Me.Caption = "Mehr als die Hälfte ist geschafft"
    175. End Select
    178. Next lngZeile
    179. End With
    182. 'Um unser Ergebnis anzuzeigen schalten wir zuletzt die Bildschirmaktualisierung wieder
    183. 'ein
    184. Application.ScreenUpdating = True
    185. 'MsgBox n & " Maschinen aus der Liste sind in den Produktionshallen."
    186. 'Endzeit in Label schreiben
    187. Set Plan = Nothing
    188. Set Liste = Nothing
    189. Set wksZiel = Nothing
    190. Me.Label39.Caption = CDate(Time - DaZeit)
    191. Me.Label35.Caption = Time
    192. Application.StatusBar = OldTxt
    193. 'Ergebnis in Labels schreiben
    194. Me.Label37.Caption = "Alle fehlenden Maschinen wurden hinzugefügt"
    195. Me.Label38.Caption = "Viel Spaß beim arbeiten :)"
    196. 'Button deaktivieren
    197. CommandButton1.Enabled = True
    198. Exit Sub
    199. 'Fehler: MsgBox "Unerwarteter Fehler - Richtige Datei mit richtigem Blatt geöffnet ??"
    200. Fehler: MsgBox " Datei: " & AbgDatei & " - Blatt: " & Deliver1 & Chr(10) & "Datei geöffnet? und/oder Name richtig geschrieben??" & Chr(10), vbOKOnly, " Fehler bitte prüfen " '& Error()
    201. CommandButton1.Enabled = True
    202. End Sub
    203. 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)
    204. End Sub
    206. 'Zentrieren auf beiden Bildschirmen des Fenstern
    207. Private Sub UserForm_Initialize()
    208. Dim sngTop As Single, sngLeft As Single
    209. Me.StartUpPosition = 0
    210. sngLeft = Application.Left + Application.Width / 2 - Me.Width / 2
    211. sngTop = Application.Top + Application.Height / 2 - Me.Height / 2
    212. Me.Left = sngLeft
    213. Me.Top = sngTop
    214. Label13 = Date
    215. Label28 = Time
    216. End Sub

    Dieser Beitrag wurde bereits 8 mal editiert, zuletzt von „UltraTM“ ()

    Hallo

    Mir ist folgendes aufgefallen:

    Visual Basic-Quellcode

    1. wksZiel.Cells(lngLetzteZiel + 1, 2) = "'" & .Cells(lngZeile, 4) 'Seriennummer


    mit diesem Hochkomma machst Du ja aus einer Zahl ein Text. Evtl. müsstest Du das weglassen und auch die Tabelle entsprechen von Text in eine Zahl unmwandeln.

    Evtl. könnte man auch die Zahl in einen Text umwandeln...

    Visual Basic-Quellcode

    1. (If IsError(Application.Match(CStr(.Cells(lngZeile, 4)), wksZiel.Columns(2), 0)) Then)

    Panter schrieb:

    Hallo

    Mir ist folgendes aufgefallen:

    Visual Basic-Quellcode

    1. wksZiel.Cells(lngLetzteZiel + 1, 2) = "'" & .Cells(lngZeile, 4) 'Seriennummer


    mit diesem Hochkomma machst Du ja aus einer Zahl ein Text. Evtl. müsstest Du das weglassen und auch die Tabelle entsprechen von Text in eine Zahl unmwandeln.

    Evtl. könnte man auch die Zahl in einen Text umwandeln...

    Visual Basic-Quellcode

    1. (If IsError(Application.Match(CStr(.Cells(lngZeile, 4)), wksZiel.Columns(2), 0)) Then)




    Hallo ja das hatte ich so gemacht im ersten Moment damit er Zahlen richtig darstellt. Leider sind bei unseren Robotern die Seriennummern auch mit Buchstaben versehen. Aber das habe ich auch gelöst bekommen indem ich die Spalte als Zahl formatiere aber beim einfügen über VBA macht er die Seriennummern mit Buchstaben automatisch zum Text das klappt also :)

    Hallo

    Die Serienummern welche immer wieder eingefügt werden, enthalten diese auch Buchstaben?

    Falls nein könnte es eben sein, dass Excel diese nicht richtig vergleicht.

    Vielliecht könnte man das so lösen:

    Visual Basic-Quellcode

    1. Dim SuchTXT
    3. if isNumeric(.Cells(lngZeile, 4) then
    4. SuchTXT = .Cells(lngZeile, 4) * 1
    5. Else
    6. SuchTXT = .Cells(lngZeile, 4)
    7. End If
    10. If IsError(Application.Match(SuchTXT), wksZiel.Columns(2), 0)) Then


    Lg Panter

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Panter“ ()

Facebook
Telefonspende