Excel / VBA - beschleunigen

  • Excel

Es gibt 17 Antworten in diesem Thema. Der letzte Beitrag () ist von peterfido.

    Excel / VBA - beschleunigen

    Liebes Forum,

    Ich habe einen ziemlich langen Code...

    und wenn ich diesen ausführe und ich habe sehr viele Daten (somit wirklich sehr viele befüllte Zeilen... die abgearbeitet werden....) dann friert Excel "offiziell" ein.... - also man möchte meinen, dass Excel abgestürzt ist... jedoch arbeitet es im Hintergrund weiter! Das habe ich schon mit bereits weniger Daten ausprobiert... da ist es auch so... Excel friert ein... und dann nach einer gewissen Zeit, ist er fertig und alles wieder OK!

    So...

    Nun habe ich aber das Problem, dass ich eine Megaberechnung habe... die bereits schon über 20Tage lang non-stop läuft...

    der Witz an der Sache ist der... dass... wenn ich mir beim Taskmanager die Prozessor-Auslastung von Excel ansehe... dann habe ich lediglich 13%

    Kann mir jemand von euch sagen, was ich tun kann, damit ich Excel, bzw. VBA, mehr Rechenleistung zuweisen kann??
    Habe im Inet recherchiert... und mal eine Idee aufgeschnappt... von wegen... man müsste wohl über die Registry was drehen...??!

    Achja... und Code-Verbesserung schließe ich jz mal bewusst aus... mir geht's wirklich darum, dass ich meine Hardware, die ich habe, auch vernünftig auslasten kann...

    alles läuft auf Excel 2013 (Office 64 bit) mit einem Intel i7 Quadcore Rechner... und genüüüügend Arbeitsspeicher... alles auf Win 7

    Wäre dankbar für einen gezielten Vorschlag, wie ich das wohl anstellen könnte!

    Vielen Dank!

    VG Tim

    PS:
    Multithreading ist im Excel natürlich auch aktiviert... (falls jemand auf die Idee kommen sollte...)

    Hallo,

    so ohne Code kann man da nicht viel zu sagen. 13 Prozent sind bei 8 Kernen ein voll ausgelasteter Kern. Was Du da seit zwanzig Tagen berechnet lässt, geht evtl. mit einer anderen Programmierspache schneller.

    Selbst wenn jetzt Tipps wie Fensteraktualisierung abschalten, keine Zellen als Variablen mißbrauchen, Code optimieren,... kommen, müsstest Du wohl wieder von vorne rechnen lassen. In zwanzig Tagen weißt Du dann, ob es was genützt hat. :D
    Gruß
    Peterfido

    Keine Unterstützung per PN!

    Also wenn ich das hier lese:

    ​So...Nun habe ich aber das Problem, dass ich eine Megaberechnung habe... die bereits schon über 20Tage lang non-stop läuft...


    Dann muss ich schon schmunzeln. Versuchst du einen 256 Bit Schlüssel zu knacken oder die Zukunft voraus zu sehen ? :D

    Nein also ernsthaft, sicher das du das mit Excel machen willst? Mir fällt hardware mäßig nicht viel ein bezüglich Excel außer das man die Prozess Priorität vll noch auf High setzen könnte.
    Das ist meine Signatur und sie wird wunderbar sein!

    ereza schrieb:

    Code-Verbesserung schließe ich jz mal bewusst aus
    Wenn du das als Lasttest verwenden willst, darfst du vielleicht genau das nicht.
    Dann musst du ggf. dafür sorgen, dass alle Funktionen, die in einen Waitstate gelangen können, vermieden werden.
    Was erzeugt den deine Grundlast?
    Wenn du das in reinem VBA versuchst, wird's eng, da du ohne Tricks kein Multithreading (und damit keine Parallelverarbeitung) machen kannst.
    Da passen die 13% (bzw. 12.5%) zu einem voll ausgelasteten Kern eines 8-Kern-System.

    Wenn du mehrere Kerne auslasten willst, musst du Excel die Last nativ erzeugen lassen, und wenn mit VBA dann höchstens durch parallel ausgeführte UDFs.

    Kannst du vielleicht mal präzisieren, wie deine bisherigen Versuche aussehen?
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

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

    hi Leute...

    naja... also... Zukunft will ich ja nicht vorrausssehen... hahaha... aber... es reicht schon bei folgendem:

    im gebastelten screenshot... mal nur ein kleiner auszug... es soll bei den Aufträgen geschaut werden wie sich die Gesamtsummen (Euro-Beträge) zusammensetzen... dafür muss für jeden einzelnen Eintrag eine weitere Tabelle durchgegangen werden... bei der jeweils wieder alle zugehörigen Einzelbeträge rausgesucht werden und im 1.Durchlauf summiert werden... stimmt dann die Gesamtsumme mit der Summe der Teilsummen überein, so werden die Teilbeträge grün eingefärbelt usw....

    das ist jz aber nur ein kleiner auschnitt.... aber ich möchte damit sagen... dass eben viele Daten 100.000de von Zeilen sehr oft durchgeschaut werden müssen und verglichen wird, summiert wird oder ähnliches... und oftmals ist es so... dass eine zeile nach einer anderen von einer Megatabelle durchlaufen wird... dann wird für einen bestimmten Umstand/Wert etc. wieder eine andere Megatabelle durchgegangen... und für diese dann wieder eine... usw...
    --> also im Grunde ist es eine wahnsinnige Durchlauf bzw. Ablaufarbeit....

    Aber... ich habe das auch bewusst so programmiert, damit ich Fehler ausschließen kann etc.. und es oftmals gar nicht anders geht....

    Das ist aber auch der Grund, warum das ganze so aufwendig und langwierig ist....

    @petaod

    Wenn du mehrere Kerne auslasten willst, musst du Excel die Last nativ erzeugen lassen, und wenn mit VBA dann höchstens durch parallel ausgeführte UDFs.


    das klingt ja mal interessant.... was meinst du damit genau... und was sind UDF's?
    kannst du mir hierfür ein einfaches Beispiel nennen?


    und... wollte mal generell fragen... gibt's da echt keinen Schmäh wie ich Excel pimpen kann... vl. gibt's ja spezielle Modifikationen in der Registry etc.? oder vl. eine Art plugin etc., so dass man die Verarbeitung multithreading gestützt laufen lassen kann...??!

    Vielen Dank, schon mal für die bisherigen Ideen....



    PS:

    Wenn es hilfreich ist... hier mein Code...
    Aber... der ist vieeel zu lange... also... soll nur dazu dienen... dass ihr a bissl die Struktur von dem ganzen seht... und seht... dass hier viele schleifen abgearbeitet werden müssen usw.... - also nix jz zum reindenken...

    Spoiler anzeigen

    Quellcode

    1. '------------------------------------------------------------------------------------------------------------------------
    2. '- Falls bis zum Schritt 3 alles ausgeführt wurde... (Anweisungen, für die Bereinigung, aus Schritt 3 entnommen.... -
    3. '------------------------------------------------------------------------------------------------------------------------
    4. 'Ermittlung der letzten Trennspalte
    5. LetzteTrennSpalte = Tabelle17.Cells(1, Columns.Count).End(xlToLeft).Column + 1
    6. 'Ermittlung letzter Spalte... --> einfach LetzteTrennSpalte + 20
    7. LetzteSpalte = LetzteTrennSpalte + 20
    8. For a = 6 To LetzteTrennSpalte
    9. If Tabelle17.Cells(1, a).Interior.Pattern = xlGrid Then
    10. y_TrennSpalte = übergabe(a)
    11. Else
    12. End If
    13. Next
    15. If y_TrennSpalte > 6 Then
    16. Tabelle17.Range(Tabelle17.Cells(1, y_TrennSpalte), Tabelle17.Cells(1048576, y_TrennSpalte)).Interior.Pattern = xlNone
    17. Tabelle17.Range(Tabelle17.Cells(1, y_TrennSpalte), Tabelle17.Cells(1048576, y_TrennSpalte)).Borders(xlDiagonalDown).LineStyle = xlNone
    18. Tabelle17.Range(Tabelle17.Cells(1, y_TrennSpalte), Tabelle17.Cells(1048576, y_TrennSpalte)).Borders(xlDiagonalUp).LineStyle = xlNone
    19. Tabelle17.Range(Tabelle17.Cells(1, y_TrennSpalte), Tabelle17.Cells(1048576, y_TrennSpalte)).Borders(xlEdgeLeft).LineStyle = xlNone
    20. Tabelle17.Range(Tabelle17.Cells(1, y_TrennSpalte), Tabelle17.Cells(1048576, y_TrennSpalte)).Borders(xlEdgeTop).LineStyle = xlNone
    21. Tabelle17.Range(Tabelle17.Cells(1, y_TrennSpalte), Tabelle17.Cells(1048576, y_TrennSpalte)).Borders(xlEdgeBottom).LineStyle = xlNone
    22. Tabelle17.Range(Tabelle17.Cells(1, y_TrennSpalte), Tabelle17.Cells(1048576, y_TrennSpalte)).Borders(xlEdgeRight).LineStyle = xlNone
    23. Tabelle17.Range(Tabelle17.Cells(1, y_TrennSpalte), Tabelle17.Cells(1048576, y_TrennSpalte)).Borders(xlInsideVertical).LineStyle = xlNone
    24. Tabelle17.Range(Tabelle17.Cells(1, y_TrennSpalte), Tabelle17.Cells(1048576, y_TrennSpalte)).Borders(xlInsideHorizontal).LineStyle = xlNone
    25. Tabelle17.Range(Tabelle17.Cells(1, y_TrennSpalte), Tabelle17.Cells(1048576, LetzteSpalte)).ClearContents
    26. Else
    27. End If
    29. Range("D2:D1048576").ClearContents
    30. Range(Tabelle17.Cells(2, 130), Tabelle17.Cells(1048576, 130)).ClearContents
    31. Range("E2:Z1048576").Interior.Color = xlNone
    32. Tabelle13.Range("BG2:BG1048576").ClearContents
    33. Tabelle13.Range("BG2:BG1048576").Font.Color = -11489280
    35. 'Vermeintliche Daten von vorher aus Tabelle13 löschen....
    36. Tabelle13.Range("BI1:BO1048576").ClearContents
    38. b = Tabelle13.Cells(Rows.Count, 55).End(xlUp).Row
    39. d = Tabelle17.Cells(Rows.Count, 5).End(xlUp).Row
    40. h = Tabelle17.Cells(1, Columns.Count).End(xlToLeft).Column
    42. anzahl_gesamt = b - 1
    44. Kennzeichen1 = False
    45. Kennzeichen2 = False
    46. kz_ü = False
    47. kz_BetragGleichGesamtbetrag = False
    48. hilfswert_index = 2
    52. 'Schaue Tabelle von "6 - Sämtliche Bestellungen" --> Spalte BB und BD an....
    53. For a = 2 To b
    54. AUFNR_BC = Tabelle13.Cells(a, 55)
    55. Gesamtbetrag_BD = Tabelle13.Cells(a, 56)
    56. 'Schaue Tabelle von "7 - Erw. Darstellung Aufträge" --> Zeile für Zeile, von Zeile 2 weg, aus an....
    57. For c = 2 To d
    58. AUFNR_aktuell = Tabelle17.Cells(c, 5)
    59. 'Wenn Auftragsnummer von "7 - Erw. Darstellung Aufträge" = Auftragsnummer von "6 - Sämtliche Bestellungen"
    60. If AUFNR_aktuell = AUFNR_BC Then
    61. 'Schaue dir jeweils alle Spaltenwerte von der betroffenen Zeile an...
    63. Gesamtbetrag_BD_gerundet = Round(Gesamtbetrag_BD, 2)
    64. 'Prüfe zuerst ob einer von den Spalteneinträgen dem Gesamtbetrag entspricht....
    65. For k = 6 To h
    66. Betrag_aktuell = Tabelle17.Cells(c, k)
    67. Betrag_aktuell_gerundet = Round(Betrag_aktuell, 2)
    68. If Betrag_aktuell_gerundet = Gesamtbetrag_BD_gerundet And Tabelle17.Cells(1, k) <> "Lohnkosten, eigen" Then
    69. kz_BetragGleichGesamtbetrag = True
    70. Else
    71. End If
    72. Next
    74. 'Fall 1: Der Gesamtbetrag von "6 - Sämtliche Bestellungen" entspricht dem aktuell betrachteten Betrag
    75. If kz_BetragGleichGesamtbetrag = True Then
    76. For y = 6 To h
    77. Betrag_aktuell = Tabelle17.Cells(c, y)
    78. Betrag_aktuell_gerundet = Round(Betrag_aktuell, 2)
    79. If Betrag_aktuell_gerundet = Gesamtbetrag_BD_gerundet And Tabelle17.Cells(1, y) <> "Lohnkosten, eigen" Then
    80. Kennzeichen1 = True
    81. 'Wert für Löschkennzeichen Eintragen...
    82. Tabelle17.Cells(c, 4) = Tabelle13.Cells(a, 53)
    83. 'Auftragsnummer in gelb einfärben...
    84. Tabelle17.Range(Tabelle17.Cells(c, 5), Tabelle17.Cells(c, 5)).Interior.Color = 65535
    85. 'Betrag in grün einfärben...
    86. Tabelle17.Range(Tabelle17.Cells(c, y), Tabelle17.Cells(c, y)).Interior.Color = 5287936
    87. Else
    88. Kennzeichen1 = False
    89. End If
    90. Next
    91. Else
    92. End If
    93. 'Fall 2: Prüfe ob Zeile eingefärbelt ist.... Wenn nicht, dann..
    94. ' Addiere die Beträge und schaue ob Summe gleich Gesamtbetrag von "6 - Sämtliche Bestellungen" entspricht...
    95. If kz_BetragGleichGesamtbetrag = False Then
    96. For y = 6 To h
    97. If Kennzeichen1 = False Then
    98. If Tabelle17.Cells(1, y) <> "Lohnkosten, eigen" Then
    99. Betrag_aktuell = Tabelle17.Cells(c, y)
    100. Gesamtbetrag_aktuell = Gesamtbetrag_aktuell + Betrag_aktuell
    101. Gesamtbetrag_aktuell_gerundet = Round(Gesamtbetrag_aktuell, 2)
    102. If Gesamtbetrag_aktuell_gerundet = Gesamtbetrag_BD_gerundet Then
    103. 'Wert für Löschkennzeichen Eintragen...
    104. Tabelle17.Cells(c, 4) = Tabelle13.Cells(a, 53)
    105. 'Auftragsnummer in gelb einfärben...
    106. Tabelle17.Range(Tabelle17.Cells(c, 5), Tabelle17.Cells(c, 5)).Interior.Color = 65535
    107. 'Betrag in grün einfärben...
    108. Tabelle17.Range(Tabelle17.Cells(c, y), Tabelle17.Cells(c, y)).Interior.Color = 5287936
    109. If Kennzeichen2 = True And Tabelle17.Range(Tabelle17.Cells(c, 5), Tabelle17.Cells(c, 5)).Interior.Color = 65535 Then
    110. For f = 2 To Tabelle17.Cells(Rows.Count, 130).End(xlUp).Row
    111. merke_y = Cells(f, 130)
    112. Tabelle17.Range(Tabelle17.Cells(c, merke_y), Tabelle17.Cells(c, merke_y)).Interior.Color = 5287936
    113. Next
    114. Kennzeichen2 = False
    115. Tabelle17.Range(Tabelle17.Cells(2, 130), Tabelle17.Cells(1048576, 130)).ClearContents
    116. Else
    117. End If
    118. Else
    119. 'Wenn später die Teilsummen markiert werden müssen, wird hier der Index in die Spalte "DZ"
    120. Tabelle17.Cells(hilfswert_index, 130).Value = y
    121. Kennzeichen2 = True
    122. hilfswert_index = hilfswert_index + 1
    123. End If
    124. Else
    125. End If
    126. Else
    127. End If
    128. Next
    129. Gesamtbetrag_aktuell = 0
    130. hilfswert_index = 2
    131. End If
    132. 'kz_BetragGleichGesamtbetrag wieder für den nächsten Schleifendurchgang auf False setzen!
    133. kz_BetragGleichGesamtbetrag = False
    134. Else
    135. End If
    137. 'Fehlerhafte 0€-Einfärbungen entfernen...
    138. For g = 6 To h
    139. If Tabelle17.Cells(c, g).Value = "" Or Tabelle17.Cells(c, g).Value = 0 And Tabelle17.Range(Tabelle17.Cells(c, g), Tabelle17.Cells(c, g)).Interior.Color <> xlNone Then
    140. Tabelle17.Range(Tabelle17.Cells(c, g), Tabelle17.Cells(c, g)).Interior.Color = xlNone
    141. Else
    142. End If
    143. Next
    144. Next
    145. anzahl_durchgang = anzahl_durchgang + 1
    146. prozentwert = Round(((anzahl_durchgang / anzahl_gesamt) * 100), 2)
    147. Tabelle17.Range("B22").Value = "Vorgang 1/4: " & prozentwert & "%"
    148. Next
    150. '------------------------------------------------------------------------------------------------
    151. '- Überprüfung ob wirklich alle Auftragsnummer, wo Bestellungen drauf waren eingefärbt wurden!! -
    152. '------------------------------------------------------------------------------------------------
    153. 'Schleife für Tabelle13... --> Zeilen:
    154. anzahl_durchgang = 0
    155. anzahl_gesamt = b - 1
    157. For a = 2 To b
    158. AUFNR_BC = Tabelle13.Cells(a, 55)
    159. Gesamtbetrag_tab13 = Tabelle13.Cells(a, 56)
    160. Gesamtbetrag_tab13_gerundet = Round(Gesamtbetrag_tab13, 2)
    161. WertFürLKZ_tab13 = Tabelle13.Cells(a, 53)
    162. 'Schleife für Tabelle17... --> Zeilen:
    163. For c = 2 To d
    164. AUFNR_aktuell = Tabelle17.Cells(c, 5)
    165. If AUFNR_aktuell = AUFNR_BC Then
    166. 'Auftragsnummer gelb eingefärbt?
    167. If Tabelle17.Cells(c, 5).Interior.Color <> 65535 Then
    168. kz_gelb_NichtMarkiert = True
    169. Else
    170. End If
    171. 'aktuell betrachtete Auftragsnummer in Tabelle17 ist gelb markiert...
    172. If kz_gelb_NichtMarkiert = False Then
    173. 'Schleife für Tabelle17... --> Spalte:
    174. For y = 6 To h
    175. 'Betrag die grün sind ergeben Gesamtsumme?...
    176. If Tabelle17.Cells(c, y).Interior.Color = 5287936 Then
    177. BetragInGrün_Aktuell = Tabelle17.Cells(c, y)
    178. BetragInGrün_Gesamt = BetragInGrün_Gesamt + BetragInGrün_Aktuell
    179. Else
    180. End If
    181. Next
    182. Else
    183. End If
    184. 'Stimmt Gesamtbetrag von Tabelle13 mit den "grünen Gesamtbetrag" überein?
    185. BetragInGrün_Gesamt_gerundet = Round(BetragInGrün_Gesamt, 2)
    186. If BetragInGrün_Gesamt_gerundet = Gesamtbetrag_tab13_gerundet Then
    187. kz_GesamtbetragAusBestellungPasst = True
    188. Else
    189. kz_GesamtbetragAusBestellungPasst = False
    190. End If
    191. 'Stimmt Wert für Löschkennzeichen überein?
    192. WertFürLKZ_tab17 = Tabelle17.Cells(c, 4)
    193. If WertFürLKZ_tab17 = WertFürLKZ_tab13 Then
    194. kz_WertFürLKZPasst = True
    195. Else
    196. kz_WertFürLKZPasst = False
    197. End If
    198. 'Wenn alles Passt wird der grüne Haken gesetzt...
    199. If kz_gelb_NichtMarkiert = False And kz_GesamtbetragAusBestellungPasst = True And kz_WertFürLKZPasst = True Then
    200. Tabelle13.Cells(a, 59).Value = "ü"
    201. 'Wenn zwar gelb markiert wurde und der Wert für das Löschkennzeichen richtig gesetzt wurde... aber die Gesamtsummen nicht übereinstimmen...
    202. ElseIf kz_gelb_NichtMarkiert = False And kz_WertFürLKZPasst = True And kz_GesamtbetragAusBestellungPasst = False Then
    203. Tabelle13.Cells(a, 59).Value = "x"
    204. 'Liste für misslungene Einträge... bzw. Einträge die manuell korrigiert werden müssen....
    205. 'Überschrift...
    206. Tabelle13.Cells(1, 61).Value = "Auftragsnummer, bei der manuell korrigiert werden muss:"
    207. Tabelle13.Cells(1, 62).Value = "AUFNR wurde gelb markiert? (JA/NEIN):"
    208. Tabelle13.Cells(1, 63).Value = "Wert für Löschkennzeichen wurde richtig gesetzt? (JA/NEIN):"
    209. Tabelle13.Cells(1, 64).Value = "Gesamtbetrag aus Bestellung stimmt überein? (JA/NEIN):"
    210. Tabelle13.Cells(1, 65).Value = "Aufsummierter Gesamtbetrag aus Tab 7:"
    211. Tabelle13.Cells(1, 66).Value = "Referenz-Gesamtbetrag aus diesem Tab:"
    212. Tabelle13.Cells(1, 67).Value = "Referenz-Wert für Löschkennzeichen aus diesem Tab:"
    213. 'Einträge...
    214. indx = Tabelle13.Cells(Rows.Count, 61).End(xlUp).Row + 1
    215. Tabelle13.Cells(indx, 61).Value = AUFNR_aktuell
    216. Tabelle13.Cells(indx, 62).Value = "JA"
    217. Tabelle13.Cells(indx, 63).Value = "JA"
    218. Tabelle13.Cells(indx, 64).Value = "NEIN"
    219. Tabelle13.Cells(indx, 65).Value = BetragInGrün_Gesamt
    220. Tabelle13.Cells(indx, 66).Value = Gesamtbetrag_tab13_gerundet
    221. Tabelle13.Cells(indx, 67).Value = WertFürLKZ_tab13
    222. 'Wenn zwar gelb markiert wurde aber der Wert für das Löschkennzeichen nicht richtig gesetzt wurde... und die Gesamtsummen nicht übereinstimmen...
    223. ElseIf kz_gelb_NichtMarkiert = False And kz_WertFürLKZPasst = False And kz_GesamtbetragAusBestellungPasst = False Then
    224. Tabelle13.Cells(a, 59).Value = "x"
    225. 'Liste für misslungene Einträge... bzw. Einträge die manuell korrigiert werden müssen....
    226. 'Überschrift...
    227. Tabelle13.Cells(1, 61).Value = "Auftragsnummer, bei der manuell korrigiert werden muss:"
    228. Tabelle13.Cells(1, 62).Value = "AUFNR wurde gelb markiert? (JA/NEIN):"
    229. Tabelle13.Cells(1, 63).Value = "Wert für Löschkennzeichen wurde richtig gesetzt? (JA/NEIN):"
    230. Tabelle13.Cells(1, 64).Value = "Gesamtbetrag aus Bestellung stimmt überein? (JA/NEIN):"
    231. Tabelle13.Cells(1, 65).Value = "Aufsummierter Gesamtbetrag aus Tab 7:"
    232. Tabelle13.Cells(1, 66).Value = "Referenz-Gesamtbetrag aus diesem Tab:"
    233. Tabelle13.Cells(1, 67).Value = "Referenz-Wert für Löschkennzeichen aus diesem Tab:"
    234. 'Einträge...
    235. indx = Tabelle13.Cells(Rows.Count, 61).End(xlUp).Row + 1
    236. Tabelle13.Cells(indx, 61).Value = AUFNR_aktuell
    237. Tabelle13.Cells(indx, 62).Value = "JA"
    238. Tabelle13.Cells(indx, 63).Value = "NEIN"
    239. Tabelle13.Cells(indx, 64).Value = "NEIN"
    240. Tabelle13.Cells(indx, 65).Value = BetragInGrün_Gesamt
    241. Tabelle13.Cells(indx, 66).Value = Gesamtbetrag_tab13_gerundet
    242. Tabelle13.Cells(indx, 67).Value = WertFürLKZ_tab13
    243. 'Wenn zwar gelb markiert wurde aber der Wert für das Löschkennzeichen nicht richtig gesetzt wurde... aber die Gesamtsummen übereinstimmen...
    244. ElseIf kz_gelb_NichtMarkiert = False And kz_WertFürLKZPasst = False And kz_GesamtbetragAusBestellungPasst = True Then
    245. Tabelle13.Cells(a, 59).Value = "x"
    246. 'Liste für misslungene Einträge... bzw. Einträge die manuell korrigiert werden müssen....
    247. 'Überschrift...
    248. Tabelle13.Cells(1, 61).Value = "Auftragsnummer, bei der manuell korrigiert werden muss:"
    249. Tabelle13.Cells(1, 62).Value = "AUFNR wurde gelb markiert? (JA/NEIN):"
    250. Tabelle13.Cells(1, 63).Value = "Wert für Löschkennzeichen wurde richtig gesetzt? (JA/NEIN):"
    251. Tabelle13.Cells(1, 64).Value = "Gesamtbetrag aus Bestellung stimmt überein? (JA/NEIN):"
    252. Tabelle13.Cells(1, 65).Value = "Aufsummierter Gesamtbetrag aus Tab 7:"
    253. Tabelle13.Cells(1, 66).Value = "Referenz-Gesamtbetrag aus diesem Tab:"
    254. Tabelle13.Cells(1, 67).Value = "Referenz-Wert für Löschkennzeichen aus diesem Tab:"
    255. 'Einträge...
    256. indx = Tabelle13.Cells(Rows.Count, 61).End(xlUp).Row + 1
    257. Tabelle13.Cells(indx, 61).Value = AUFNR_aktuell
    258. Tabelle13.Cells(indx, 62).Value = "JA"
    259. Tabelle13.Cells(indx, 63).Value = "NEIN"
    260. Tabelle13.Cells(indx, 64).Value = "JA"
    261. Tabelle13.Cells(indx, 65).Value = BetragInGrün_Gesamt
    262. Tabelle13.Cells(indx, 66).Value = Gesamtbetrag_tab13_gerundet
    263. Tabelle13.Cells(indx, 67).Value = WertFürLKZ_tab13
    264. 'Wenn NICHT gelb markiert wurde, der Wert für LKZ nicht gesetzt wurde und die Gesamtsummen nicht übereinstimmen....
    265. ElseIf kz_gelb_NichtMarkiert = True And kz_WertFürLKZPasst = False And kz_GesamtbetragAusBestellungPasst = False Then
    266. Tabelle13.Cells(a, 59).Value = "x"
    267. 'Liste für misslungene Einträge... bzw. Einträge die manuell korrigiert werden müssen....
    268. 'Überschrift...
    269. Tabelle13.Cells(1, 61).Value = "Auftragsnummer, bei der manuell korrigiert werden muss:"
    270. Tabelle13.Cells(1, 62).Value = "AUFNR wurde gelb markiert? (JA/NEIN):"
    271. Tabelle13.Cells(1, 63).Value = "Wert für Löschkennzeichen wurde richtig gesetzt? (JA/NEIN):"
    272. Tabelle13.Cells(1, 64).Value = "Gesamtbetrag aus Bestellung stimmt überein? (JA/NEIN):"
    273. Tabelle13.Cells(1, 65).Value = "Aufsummierter Gesamtbetrag aus Tab 7:"
    274. Tabelle13.Cells(1, 66).Value = "Referenz-Gesamtbetrag aus diesem Tab:"
    275. Tabelle13.Cells(1, 67).Value = "Referenz-Wert für Löschkennzeichen aus diesem Tab:"
    276. 'Einträge...
    277. indx = Tabelle13.Cells(Rows.Count, 61).End(xlUp).Row + 1
    278. Tabelle13.Cells(indx, 61).Value = AUFNR_aktuell
    279. Tabelle13.Cells(indx, 62).Value = "NEIN"
    280. Tabelle13.Cells(indx, 63).Value = "NEIN"
    281. Tabelle13.Cells(indx, 64).Value = "NEIN"
    282. Tabelle13.Cells(indx, 65).Value = BetragInGrün_Gesamt
    283. Tabelle13.Cells(indx, 66).Value = Gesamtbetrag_tab13_gerundet
    284. Tabelle13.Cells(indx, 67).Value = WertFürLKZ_tab13
    285. 'Wenn NICHT gelb markiert wurde, der Wert für LKZ aber richtigt gesetzt wurde, die Gesamtsummen aber nicht übereinstimmen....
    286. ElseIf kz_gelb_NichtMarkiert = True And kz_WertFürLKZPasst = True And kz_GesamtbetragAusBestellungPasst = False Then
    287. Tabelle13.Cells(a, 59).Value = "x"
    288. 'Liste für misslungene Einträge... bzw. Einträge die manuell korrigiert werden müssen....
    289. 'Überschrift...
    290. Tabelle13.Cells(1, 61).Value = "Auftragsnummer, bei der manuell korrigiert werden muss:"
    291. Tabelle13.Cells(1, 62).Value = "AUFNR wurde gelb markiert? (JA/NEIN):"
    292. Tabelle13.Cells(1, 63).Value = "Wert für Löschkennzeichen wurde richtig gesetzt? (JA/NEIN):"
    293. Tabelle13.Cells(1, 64).Value = "Gesamtbetrag aus Bestellung stimmt überein? (JA/NEIN):"
    294. Tabelle13.Cells(1, 65).Value = "Aufsummierter Gesamtbetrag aus Tab 7:"
    295. Tabelle13.Cells(1, 66).Value = "Referenz-Gesamtbetrag aus diesem Tab:"
    296. Tabelle13.Cells(1, 67).Value = "Referenz-Wert für Löschkennzeichen aus diesem Tab:"
    297. 'Einträge...
    298. indx = Tabelle13.Cells(Rows.Count, 61).End(xlUp).Row + 1
    299. Tabelle13.Cells(indx, 61).Value = AUFNR_aktuell
    300. Tabelle13.Cells(indx, 62).Value = "NEIN"
    301. Tabelle13.Cells(indx, 63).Value = "JA"
    302. Tabelle13.Cells(indx, 64).Value = "NEIN"
    303. Tabelle13.Cells(indx, 65).Value = BetragInGrün_Gesamt
    304. Tabelle13.Cells(indx, 66).Value = Gesamtbetrag_tab13_gerundet
    305. Tabelle13.Cells(indx, 67).Value = WertFürLKZ_tab13
    306. 'Wenn NICHT gelb markiert wurde, der Wert für LKZ nicht gesetzt wurde, aber die Gesamtsummen übereinstimmen....
    307. ElseIf kz_gelb_NichtMarkiert = True And kz_WertFürLKZPasst = False And kz_GesamtbetragAusBestellungPasst = True Then
    308. Tabelle13.Cells(a, 59).Value = "x"
    309. 'Liste für misslungene Einträge... bzw. Einträge die manuell korrigiert werden müssen....
    310. 'Überschrift...
    311. Tabelle13.Cells(1, 61).Value = "Auftragsnummer, bei der manuell korrigiert werden muss:"
    312. Tabelle13.Cells(1, 62).Value = "AUFNR wurde gelb markiert? (JA/NEIN):"
    313. Tabelle13.Cells(1, 63).Value = "Wert für Löschkennzeichen wurde richtig gesetzt? (JA/NEIN):"
    314. Tabelle13.Cells(1, 64).Value = "Gesamtbetrag aus Bestellung stimmt überein? (JA/NEIN):"
    315. Tabelle13.Cells(1, 65).Value = "Aufsummierter Gesamtbetrag aus Tab 7:"
    316. Tabelle13.Cells(1, 66).Value = "Referenz-Gesamtbetrag aus diesem Tab:"
    317. Tabelle13.Cells(1, 67).Value = "Referenz-Wert für Löschkennzeichen aus diesem Tab:"
    318. 'Einträge...
    319. indx = Tabelle13.Cells(Rows.Count, 61).End(xlUp).Row + 1
    320. Tabelle13.Cells(indx, 61).Value = AUFNR_aktuell
    321. Tabelle13.Cells(indx, 62).Value = "NEIN"
    322. Tabelle13.Cells(indx, 63).Value = "NEIN"
    323. Tabelle13.Cells(indx, 64).Value = "JA"
    324. Tabelle13.Cells(indx, 65).Value = BetragInGrün_Gesamt
    325. Tabelle13.Cells(indx, 66).Value = Gesamtbetrag_tab13_gerundet
    326. Tabelle13.Cells(indx, 67).Value = WertFürLKZ_tab13
    327. Else
    328. Tabelle13.Cells(a, 59).Value = "x"
    329. 'Überschrift...
    330. Tabelle13.Cells(1, 61).Value = "Auftragsnummer, bei der manuell korrigiert werden muss:"
    331. Tabelle13.Cells(1, 62).Value = "AUFNR wurde gelb markiert? (JA/NEIN):"
    332. Tabelle13.Cells(1, 63).Value = "Wert für Löschkennzeichen wurde richtig gesetzt? (JA/NEIN):"
    333. Tabelle13.Cells(1, 64).Value = "Gesamtbetrag aus Bestellung stimmt überein? (JA/NEIN):"
    334. Tabelle13.Cells(1, 65).Value = "Aufsummierter Gesamtbetrag aus Tab 7:"
    335. Tabelle13.Cells(1, 66).Value = "Referenz-Gesamtbetrag aus diesem Tab:"
    336. Tabelle13.Cells(1, 67).Value = "Referenz-Wert für Löschkennzeichen aus diesem Tab:"
    337. 'Einträge...
    338. indx = Tabelle13.Cells(Rows.Count, 61).End(xlUp).Row + 1
    339. Tabelle13.Cells(indx, 61).Value = "Fehler in der Zeile: "
    340. Tabelle13.Cells(indx, 62).Value = c
    341. Tabelle13.Cells(indx, 63).Value = "im Tab 7!"
    342. Tabelle13.Cells(indx, 64).Value = "--> diese AufNR:"
    343. Tabelle13.Cells(indx, 65).Value = "AUFNR_aktuell"
    344. Tabelle13.Cells(indx, 66).Value = "muss überprüft"
    345. Tabelle13.Cells(indx, 67).Value = "werden!!"
    346. End If
    347. Else
    348. End If
    349. BetragInGrün_Gesamt = 0
    350. BetragInGrün_Gesamt_gerundet = 0
    351. kz_gelb_NichtMarkiert = False
    352. kz_GesamtbetragAusBestellungPasst = False
    353. kz_WertFürLKZPasst = False
    354. Next
    355. WertFürLKZ_tab13 = ""
    356. anzahl_durchgang = anzahl_durchgang + 1
    357. prozentwert = Round(((anzahl_durchgang / anzahl_gesamt) * 100), 2)
    358. Tabelle17.Range("B22").Value = "Vorgang 2/4: " & prozentwert & "%"
    359. Next
    361. 'Überprüfen ob alles einwandfrei abgearbeitet wurde...
    362. kz_ü = False
    363. For a = 2 To b
    364. If Tabelle13.Cells(a, 59) = "x" Then
    365. kz_ü = True
    366. Else
    367. End If
    368. Next
    370. '---------------------------------
    371. '- KORREKTUR -
    372. '---------------------------------
    373. 'Automatisiert Fehler berichtigen...., indem, dass alle Einzelwerte in der betroffenen Zeile von Tabelle17 addiert werden... außer, wenn das Feld leer ist oder wenn es sich
    374. 'unter der Überschriftsspalte "Lohnkosten, eigen" befindet...
    376. If kz_ü = True Then
    377. zeilenmaxBI = Tabelle13.Cells(Rows.Count, 61).End(xlUp).Row
    378. d = Tabelle17.Cells(Rows.Count, 5).End(xlUp).Row
    379. h = Tabelle17.Cells(1, Columns.Count).End(xlToLeft).Column
    380. anzahl_durchgang = 0
    381. anzahl_gesamt = zeilenmaxBI - 1
    382. For a = 2 To zeilenmaxBI
    383. GelbJaNein = Tabelle13.Cells(a, 62)
    384. If GelbJaNein = "NEIN" Then
    385. Referenzsumme = Round(Tabelle13.Cells(a, 66), 2)
    386. AufNr_tab13_BI = Tabelle13.Cells(a, 61)
    387. WertFürLKZ_tab13 = Tabelle13.Cells(a, 67)
    388. 'ZeilenSchleife für Tab 7....
    389. For b = 2 To d
    390. AufrNr_tab17 = Tabelle17.Cells(b, 5)
    391. If AufrNr_tab17 = AufNr_tab13_BI Then
    392. 'SpaltenSchleife für Tab 7....
    393. For y = 6 To h
    394. If Tabelle17.Cells(1, y).Value <> "Lohnkosten, eigen" And Tabelle17.Cells(b, y) <> "" Then
    395. WertAktuell_tab17 = Round(Tabelle17.Cells(b, y), 2)
    396. GesamtWertAktuell_tab17 = Round((GesamtWertAktuell_tab17 + WertAktuell_tab17), 2)
    397. If GesamtWertAktuell_tab17 = Referenzsumme Then
    398. 'Wert für Löschkennzeichen Eintragen...
    399. Tabelle17.Cells(b, 4) = WertFürLKZ_tab13
    400. 'Auftragsnummer in gelb einfärben...
    401. Tabelle17.Cells(b, 5).Interior.Color = 65535
    402. 'Betrag in grün einfärben...
    403. Tabelle17.Cells(b, y).Interior.Color = 5287936
    404. 'wenn es sich nicht um die 'erste Spalte mit einem Wert' --> Spalte 6 handelt...
    405. If y > 6 Then
    406. kz_NachträglichEinfärben = True
    407. Else
    408. End If
    409. 'merke dir die Spaltennummern, wo Beträge standen, welche aufsummiert wurden...
    410. Else
    411. Tabelle17.Cells(1, 500).Value = "Hilfsspalte - Spaltennummern für später...:"
    412. indx2 = Tabelle17.Cells(Rows.Count, 500).End(xlUp).Row + 1
    413. Tabelle17.Cells(indx2, 500).Value = y
    414. End If
    415. Else
    416. End If
    417. Next
    418. Else
    419. End If
    420. If kz_NachträglichEinfärben = True Then
    421. zeilenEndeHSp = Tabelle17.Cells(Rows.Count, 500).End(xlUp).Row
    422. For aa = 2 To zeilenEndeHSp
    423. 'hole abgearbeitete Spaltenwerte von betroffener Zeile...
    424. yy = Tabelle17.Cells(aa, 500)
    425. 'Färbe Betrag in grün einfärben...
    426. Tabelle17.Cells(b, yy).Interior.Color = 5287936
    427. Next
    428. Else
    429. End If
    430. 'Lösche Hilfsspalte...
    431. Tabelle17.Range(Tabelle17.Cells(1, 500), Tabelle17.Cells(1048576, 500)).ClearContents
    432. kz_NachträglichEinfärben = False
    433. Next
    434. 'Werte rücksetzen... für nächsten Zeilendurchgang...
    435. kz_NachträglichEinfärben = False
    436. WertAktuell_tab17 = 0
    437. GesamtWertAktuell_tab17 = 0
    438. Referenzsumme = 0
    439. WertFürLKZ_tab13 = ""
    440. zeilenEndeHSp = 0
    441. yy = 0
    442. 'Lösche Hilfsspalte...
    443. Tabelle17.Range(Tabelle17.Cells(1, 500), Tabelle17.Cells(1048576, 500)).ClearContents
    444. Else
    445. End If
    446. anzahl_durchgang = anzahl_durchgang + 1
    447. prozentwert = Round(((anzahl_durchgang / anzahl_gesamt) * 100), 2)
    448. Tabelle17.Range("B22").Value = "Vorgang 3/4: " & prozentwert & "%"
    449. Next
    450. Else
    451. Tabelle17.Range("B22").Value = "Vorgang 3/4: 100%"
    452. End If
    453. 'Löschung der Informationen, worauf die Korrektur sich bezogen hat....:
    454. Tabelle13.Range(Tabelle13.Cells(1, 61), Tabelle13.Cells(1048576, 67)).ClearContents
    456. 'Sämtliche Felder in Tabelle 17, welche grün markiert wurden, jedoch leer sind...
    457. 'd = Tabelle17.Cells(Rows.Count, 5).End(xlUp).Row
    458. h = Tabelle17.Cells(1, Columns.Count).End(xlToLeft).Column
    459. For a = 2 To d
    460. For y = 6 To h
    461. If Tabelle17.Cells(a, y) = "" Then
    462. Tabelle17.Cells(a, y).Interior.Color = xlNone
    463. Else
    464. End If
    465. Next
    466. Next
    468. '-----------------------------------------------------------------
    469. '- ERNEUTE (nach der autom. Korrektur) ÜBERPRÜFUNG -
    470. '-----------------------------------------------------------------
    471. 'Löschung der Hakerln und "x" vom vorherigen Durchgang...
    472. Tabelle13.Range(Tabelle13.Cells(2, 59), Tabelle13.Cells(1048576, 59)).ClearContents
    474. 'Schleife für Tabelle13... --> Zeilen:
    475. anzahl_durchgang = 0
    476. anzahl_gesamt = b - 1
    478. For a = 2 To b
    479. AUFNR_BC = Tabelle13.Cells(a, 55)
    480. Gesamtbetrag_tab13 = Tabelle13.Cells(a, 56)
    481. Gesamtbetrag_tab13_gerundet = Round(Gesamtbetrag_tab13, 2)
    482. WertFürLKZ_tab13 = Tabelle13.Cells(a, 53)
    483. 'Schleife für Tabelle17... --> Zeilen:
    484. For c = 2 To d
    485. AUFNR_aktuell = Tabelle17.Cells(c, 5)
    486. If AUFNR_aktuell = AUFNR_BC Then
    487. 'Auftragsnummer gelb eingefärbt?
    488. If Tabelle17.Cells(c, 5).Interior.Color <> 65535 Then
    489. kz_gelb_NichtMarkiert = True
    490. Else
    491. End If
    492. 'aktuell betrachtete Auftragsnummer in Tabelle17 ist gelb markiert...
    493. If kz_gelb_NichtMarkiert = False Then
    494. 'Schleife für Tabelle17... --> Spalte:
    495. For y = 6 To h
    496. 'Betrag die grün sind ergeben Gesamtsumme?...
    497. If Tabelle17.Cells(c, y).Interior.Color = 5287936 Then
    498. BetragInGrün_Aktuell = Tabelle17.Cells(c, y)
    499. BetragInGrün_Gesamt = BetragInGrün_Gesamt + BetragInGrün_Aktuell
    500. Else
    501. End If
    502. Next
    503. Else
    504. End If
    505. 'Stimmt Gesamtbetrag von Tabelle13 mit den "grünen Gesamtbetrag" überein?
    506. BetragInGrün_Gesamt_gerundet = Round(BetragInGrün_Gesamt, 2)
    507. If BetragInGrün_Gesamt_gerundet = Gesamtbetrag_tab13_gerundet Then
    508. kz_GesamtbetragAusBestellungPasst = True
    509. Else
    510. kz_GesamtbetragAusBestellungPasst = False
    511. End If
    512. 'Stimmt Wert für Löschkennzeichen überein?
    513. WertFürLKZ_tab17 = Tabelle17.Cells(c, 4)
    514. If WertFürLKZ_tab17 = WertFürLKZ_tab13 Then
    515. kz_WertFürLKZPasst = True
    516. Else
    517. kz_WertFürLKZPasst = False
    518. End If
    519. 'Wenn alles Passt wird der grüne Haken gesetzt...
    520. If kz_gelb_NichtMarkiert = False And kz_GesamtbetragAusBestellungPasst = True And kz_WertFürLKZPasst = True Then
    521. Tabelle13.Cells(a, 59).Value = "ü"
    522. 'grüne Schriftfarbe...
    523. Tabelle13.Cells(a, 59).Font.Color = -11489280
    524. 'Wenn zwar gelb markiert wurde und der Wert für das Löschkennzeichen richtig gesetzt wurde... aber die Gesamtsummen nicht übereinstimmen...
    525. ElseIf kz_gelb_NichtMarkiert = False And kz_WertFürLKZPasst = True And kz_GesamtbetragAusBestellungPasst = False Then
    526. Tabelle13.Cells(a, 59).Value = "x"
    527. 'rote Schriftfarbe...
    528. Tabelle13.Cells(a, 59).Font.Color = -16776961
    529. 'Liste für misslungene Einträge... bzw. Einträge die manuell korrigiert werden müssen....
    530. 'Überschrift...
    531. Tabelle13.Cells(1, 61).Value = "Auftragsnummer, bei der manuell korrigiert werden muss:"
    532. Tabelle13.Cells(1, 62).Value = "AUFNR wurde gelb markiert? (JA/NEIN):"
    533. Tabelle13.Cells(1, 63).Value = "Wert für Löschkennzeichen wurde richtig gesetzt? (JA/NEIN):"
    534. Tabelle13.Cells(1, 64).Value = "Gesamtbetrag aus Bestellung stimmt überein? (JA/NEIN):"
    535. Tabelle13.Cells(1, 65).Value = "Aufsummierter Gesamtbetrag aus Tab 7:"
    536. Tabelle13.Cells(1, 66).Value = "Referenz-Gesamtbetrag aus diesem Tab:"
    537. Tabelle13.Cells(1, 67).Value = "Referenz-Wert für Löschkennzeichen aus diesem Tab:"
    538. 'Einträge...
    539. indx = Tabelle13.Cells(Rows.Count, 61).End(xlUp).Row + 1
    540. Tabelle13.Cells(indx, 61).Value = AUFNR_aktuell
    541. Tabelle13.Cells(indx, 62).Value = "JA"
    542. Tabelle13.Cells(indx, 63).Value = "JA"
    543. Tabelle13.Cells(indx, 64).Value = "NEIN"
    544. Tabelle13.Cells(indx, 65).Value = BetragInGrün_Gesamt
    545. Tabelle13.Cells(indx, 66).Value = Gesamtbetrag_tab13_gerundet
    546. Tabelle13.Cells(indx, 67).Value = WertFürLKZ_tab13
    547. 'Wenn zwar gelb markiert wurde aber der Wert für das Löschkennzeichen nicht richtig gesetzt wurde... und die Gesamtsummen nicht übereinstimmen...
    548. ElseIf kz_gelb_NichtMarkiert = False And kz_WertFürLKZPasst = False And kz_GesamtbetragAusBestellungPasst = False Then
    549. Tabelle13.Cells(a, 59).Value = "x"
    550. 'rote Schriftfarbe...
    551. Tabelle13.Cells(a, 59).Font.Color = -16776961
    552. 'Liste für misslungene Einträge... bzw. Einträge die manuell korrigiert werden müssen....
    553. 'Überschrift...
    554. Tabelle13.Cells(1, 61).Value = "Auftragsnummer, bei der manuell korrigiert werden muss:"
    555. Tabelle13.Cells(1, 62).Value = "AUFNR wurde gelb markiert? (JA/NEIN):"
    556. Tabelle13.Cells(1, 63).Value = "Wert für Löschkennzeichen wurde richtig gesetzt? (JA/NEIN):"
    557. Tabelle13.Cells(1, 64).Value = "Gesamtbetrag aus Bestellung stimmt überein? (JA/NEIN):"
    558. Tabelle13.Cells(1, 65).Value = "Aufsummierter Gesamtbetrag aus Tab 7:"
    559. Tabelle13.Cells(1, 66).Value = "Referenz-Gesamtbetrag aus diesem Tab:"
    560. Tabelle13.Cells(1, 67).Value = "Referenz-Wert für Löschkennzeichen aus diesem Tab:"
    561. 'Einträge...
    562. indx = Tabelle13.Cells(Rows.Count, 61).End(xlUp).Row + 1
    563. Tabelle13.Cells(indx, 61).Value = AUFNR_aktuell
    564. Tabelle13.Cells(indx, 62).Value = "JA"
    565. Tabelle13.Cells(indx, 63).Value = "NEIN"
    566. Tabelle13.Cells(indx, 64).Value = "NEIN"
    567. Tabelle13.Cells(indx, 65).Value = BetragInGrün_Gesamt
    568. Tabelle13.Cells(indx, 66).Value = Gesamtbetrag_tab13_gerundet
    569. Tabelle13.Cells(indx, 67).Value = WertFürLKZ_tab13
    570. 'Wenn zwar gelb markiert wurde aber der Wert für das Löschkennzeichen nicht richtig gesetzt wurde... aber die Gesamtsummen übereinstimmen...
    571. ElseIf kz_gelb_NichtMarkiert = False And kz_WertFürLKZPasst = False And kz_GesamtbetragAusBestellungPasst = True Then
    572. Tabelle13.Cells(a, 59).Value = "x"
    573. 'rote Schriftfarbe...
    574. Tabelle13.Cells(a, 59).Font.Color = -16776961
    575. 'Liste für misslungene Einträge... bzw. Einträge die manuell korrigiert werden müssen....
    576. 'Überschrift...
    577. Tabelle13.Cells(1, 61).Value = "Auftragsnummer, bei der manuell korrigiert werden muss:"
    578. Tabelle13.Cells(1, 62).Value = "AUFNR wurde gelb markiert? (JA/NEIN):"
    579. Tabelle13.Cells(1, 63).Value = "Wert für Löschkennzeichen wurde richtig gesetzt? (JA/NEIN):"
    580. Tabelle13.Cells(1, 64).Value = "Gesamtbetrag aus Bestellung stimmt überein? (JA/NEIN):"
    581. Tabelle13.Cells(1, 65).Value = "Aufsummierter Gesamtbetrag aus Tab 7:"
    582. Tabelle13.Cells(1, 66).Value = "Referenz-Gesamtbetrag aus diesem Tab:"
    583. Tabelle13.Cells(1, 67).Value = "Referenz-Wert für Löschkennzeichen aus diesem Tab:"
    584. 'Einträge...
    585. indx = Tabelle13.Cells(Rows.Count, 61).End(xlUp).Row + 1
    586. Tabelle13.Cells(indx, 61).Value = AUFNR_aktuell
    587. Tabelle13.Cells(indx, 62).Value = "JA"
    588. Tabelle13.Cells(indx, 63).Value = "NEIN"
    589. Tabelle13.Cells(indx, 64).Value = "JA"
    590. Tabelle13.Cells(indx, 65).Value = BetragInGrün_Gesamt
    591. Tabelle13.Cells(indx, 66).Value = Gesamtbetrag_tab13_gerundet
    592. Tabelle13.Cells(indx, 67).Value = WertFürLKZ_tab13
    593. 'Wenn NICHT gelb markiert wurde, der Wert für LKZ nicht gesetzt wurde und die Gesamtsummen nicht übereinstimmen....
    594. ElseIf kz_gelb_NichtMarkiert = True And kz_WertFürLKZPasst = False And kz_GesamtbetragAusBestellungPasst = False Then
    595. Tabelle13.Cells(a, 59).Value = "x"
    596. 'rote Schriftfarbe...
    597. Tabelle13.Cells(a, 59).Font.Color = -16776961
    598. 'Liste für misslungene Einträge... bzw. Einträge die manuell korrigiert werden müssen....
    599. 'Überschrift...
    600. Tabelle13.Cells(1, 61).Value = "Auftragsnummer, bei der manuell korrigiert werden muss:"
    601. Tabelle13.Cells(1, 62).Value = "AUFNR wurde gelb markiert? (JA/NEIN):"
    602. Tabelle13.Cells(1, 63).Value = "Wert für Löschkennzeichen wurde richtig gesetzt? (JA/NEIN):"
    603. Tabelle13.Cells(1, 64).Value = "Gesamtbetrag aus Bestellung stimmt überein? (JA/NEIN):"
    604. Tabelle13.Cells(1, 65).Value = "Aufsummierter Gesamtbetrag aus Tab 7:"
    605. Tabelle13.Cells(1, 66).Value = "Referenz-Gesamtbetrag aus diesem Tab:"
    606. Tabelle13.Cells(1, 67).Value = "Referenz-Wert für Löschkennzeichen aus diesem Tab:"
    607. 'Einträge...
    608. indx = Tabelle13.Cells(Rows.Count, 61).End(xlUp).Row + 1
    609. Tabelle13.Cells(indx, 61).Value = AUFNR_aktuell
    610. Tabelle13.Cells(indx, 62).Value = "NEIN"
    611. Tabelle13.Cells(indx, 63).Value = "NEIN"
    612. Tabelle13.Cells(indx, 64).Value = "NEIN"
    613. Tabelle13.Cells(indx, 65).Value = BetragInGrün_Gesamt
    614. Tabelle13.Cells(indx, 66).Value = Gesamtbetrag_tab13_gerundet
    615. Tabelle13.Cells(indx, 67).Value = WertFürLKZ_tab13
    616. 'Wenn NICHT gelb markiert wurde, der Wert für LKZ aber richtigt gesetzt wurde, die Gesamtsummen aber nicht übereinstimmen....
    617. ElseIf kz_gelb_NichtMarkiert = True And kz_WertFürLKZPasst = True And kz_GesamtbetragAusBestellungPasst = False Then
    618. Tabelle13.Cells(a, 59).Value = "x"
    619. 'rote Schriftfarbe...
    620. Tabelle13.Cells(a, 59).Font.Color = -16776961
    621. 'Liste für misslungene Einträge... bzw. Einträge die manuell korrigiert werden müssen....
    622. 'Überschrift...
    623. Tabelle13.Cells(1, 61).Value = "Auftragsnummer, bei der manuell korrigiert werden muss:"
    624. Tabelle13.Cells(1, 62).Value = "AUFNR wurde gelb markiert? (JA/NEIN):"
    625. Tabelle13.Cells(1, 63).Value = "Wert für Löschkennzeichen wurde richtig gesetzt? (JA/NEIN):"
    626. Tabelle13.Cells(1, 64).Value = "Gesamtbetrag aus Bestellung stimmt überein? (JA/NEIN):"
    627. Tabelle13.Cells(1, 65).Value = "Aufsummierter Gesamtbetrag aus Tab 7:"
    628. Tabelle13.Cells(1, 66).Value = "Referenz-Gesamtbetrag aus diesem Tab:"
    629. Tabelle13.Cells(1, 67).Value = "Referenz-Wert für Löschkennzeichen aus diesem Tab:"
    630. 'Einträge...
    631. indx = Tabelle13.Cells(Rows.Count, 61).End(xlUp).Row + 1
    632. Tabelle13.Cells(indx, 61).Value = AUFNR_aktuell
    633. Tabelle13.Cells(indx, 62).Value = "NEIN"
    634. Tabelle13.Cells(indx, 63).Value = "JA"
    635. Tabelle13.Cells(indx, 64).Value = "NEIN"
    636. Tabelle13.Cells(indx, 65).Value = BetragInGrün_Gesamt
    637. Tabelle13.Cells(indx, 66).Value = Gesamtbetrag_tab13_gerundet
    638. Tabelle13.Cells(indx, 67).Value = WertFürLKZ_tab13
    639. 'Wenn NICHT gelb markiert wurde, der Wert für LKZ nicht gesetzt wurde, aber die Gesamtsummen übereinstimmen....
    640. ElseIf kz_gelb_NichtMarkiert = True And kz_WertFürLKZPasst = False And kz_GesamtbetragAusBestellungPasst = True Then
    641. Tabelle13.Cells(a, 59).Value = "x"
    642. 'rote Schriftfarbe...
    643. Tabelle13.Cells(a, 59).Font.Color = -16776961
    644. 'Liste für misslungene Einträge... bzw. Einträge die manuell korrigiert werden müssen....
    645. 'Überschrift...
    646. Tabelle13.Cells(1, 61).Value = "Auftragsnummer, bei der manuell korrigiert werden muss:"
    647. Tabelle13.Cells(1, 62).Value = "AUFNR wurde gelb markiert? (JA/NEIN):"
    648. Tabelle13.Cells(1, 63).Value = "Wert für Löschkennzeichen wurde richtig gesetzt? (JA/NEIN):"
    649. Tabelle13.Cells(1, 64).Value = "Gesamtbetrag aus Bestellung stimmt überein? (JA/NEIN):"
    650. Tabelle13.Cells(1, 65).Value = "Aufsummierter Gesamtbetrag aus Tab 7:"
    651. Tabelle13.Cells(1, 66).Value = "Referenz-Gesamtbetrag aus diesem Tab:"
    652. Tabelle13.Cells(1, 67).Value = "Referenz-Wert für Löschkennzeichen aus diesem Tab:"
    653. 'Einträge...
    654. indx = Tabelle13.Cells(Rows.Count, 61).End(xlUp).Row + 1
    655. Tabelle13.Cells(indx, 61).Value = AUFNR_aktuell
    656. Tabelle13.Cells(indx, 62).Value = "NEIN"
    657. Tabelle13.Cells(indx, 63).Value = "NEIN"
    658. Tabelle13.Cells(indx, 64).Value = "JA"
    659. Tabelle13.Cells(indx, 65).Value = BetragInGrün_Gesamt
    660. Tabelle13.Cells(indx, 66).Value = Gesamtbetrag_tab13_gerundet
    661. Tabelle13.Cells(indx, 67).Value = WertFürLKZ_tab13
    662. Else
    663. Tabelle13.Cells(a, 59).Value = "x"
    664. 'rote Schriftfarbe...
    665. Tabelle13.Cells(a, 59).Font.Color = -16776961
    666. 'Überschrift...
    667. Tabelle13.Cells(1, 61).Value = "Auftragsnummer, bei der manuell korrigiert werden muss:"
    668. Tabelle13.Cells(1, 62).Value = "AUFNR wurde gelb markiert? (JA/NEIN):"
    669. Tabelle13.Cells(1, 63).Value = "Wert für Löschkennzeichen wurde richtig gesetzt? (JA/NEIN):"
    670. Tabelle13.Cells(1, 64).Value = "Gesamtbetrag aus Bestellung stimmt überein? (JA/NEIN):"
    671. Tabelle13.Cells(1, 65).Value = "Aufsummierter Gesamtbetrag aus Tab 7:"
    672. Tabelle13.Cells(1, 66).Value = "Referenz-Gesamtbetrag aus diesem Tab:"
    673. Tabelle13.Cells(1, 67).Value = "Referenz-Wert für Löschkennzeichen aus diesem Tab:"
    674. 'Einträge...
    675. indx = Tabelle13.Cells(Rows.Count, 61).End(xlUp).Row + 1
    676. Tabelle13.Cells(indx, 61).Value = "Fehler in der Zeile: "
    677. Tabelle13.Cells(indx, 62).Value = c
    678. Tabelle13.Cells(indx, 63).Value = "im Tab 7!"
    679. Tabelle13.Cells(indx, 64).Value = "--> diese AufNR:"
    680. Tabelle13.Cells(indx, 65).Value = "AUFNR_aktuell"
    681. Tabelle13.Cells(indx, 66).Value = "muss überprüft"
    682. Tabelle13.Cells(indx, 67).Value = "werden!!"
    683. End If
    684. Else
    685. End If
    686. BetragInGrün_Gesamt = 0
    687. BetragInGrün_Gesamt_gerundet = 0
    688. kz_gelb_NichtMarkiert = False
    689. kz_GesamtbetragAusBestellungPasst = False
    690. kz_WertFürLKZPasst = False
    691. Next
    692. anzahl_durchgang = anzahl_durchgang + 1
    693. prozentwert = Round(((anzahl_durchgang / anzahl_gesamt) * 100), 2)
    694. Tabelle17.Range("B22").Value = "Vorgang 4/4: " & prozentwert & "%"
    695. Next
    697. 'Überprüfen ob alles einwandfrei abgearbeitet wurde...
    698. kz_ü = False
    699. For a = 2 To b
    700. If Tabelle13.Cells(a, 59) = "x" Then
    701. kz_ü = True
    702. Else
    703. End If
    704. Next



    NACHTRAG:

    @petaod
    Meinst du mit UDF user defined function?

    Falls ja... wie kann ich das parallelisieren?? wie geht das??
    Bilder

    • Zeichnung1.jpg

      435,17 kB, 2.196×985, 238 mal angesehen

    Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von „ereza“ ()

    ereza schrieb:

    Meinst du mit UDF user defined function?
    Falls ja... wie kann ich das parallelisieren?
    Du kannst es nicht parallelisieren.
    Das kann nur Excel selbst.
    Wenn du viele Formeln hast, die unabhängig voneinander berechnet werden können, werden die von Excel während der Kalkulationsphase parallelisiert.
    Ob Excel so schlau ist, das auch für UDFs zu analysieren, weiss ich nicht.

    Generell gilt für Parallelisierung:
    Was parallel läuft, muss unabhängig voneinander sein.
    Wenn du das willst, musst du deinen Code erst mal in mehrere (8) verschiedene Elemente aufteilen, die zumindest theoretisch unabhängig voneinander laufen können müssen, also nicht voneinander abhängig sind.
    Das ist bei dir schon mal nicht gegeben, da du alles sequentiell abarbeitest.

    Stell dir eine Methode vor, die als Aufrufparameter einen bestimmten Range mit bekommt (beispielsweise die Zeilen 1-100).
    In dieser Funktion arbeitest du diesen Bereich ab.

    Visual Basic-Quellcode

    1. ​Sub ProcessRange(ByVal Rng As Range)
    2. For Each c in Rng
    3. Debug.Print c.Value 'do whatever you want
    4. Next
    5. End Sub


    Diese Methode kann von mehreren Methoden aufgerufen werden.

    Visual Basic-Quellcode

    1. ​Sub ProcessFirst
    2. ProcessRange Range("1:200")
    3. End Sub
    4. Sub ProcessSecond
    5. ProcessRange Range("201:400")
    6. End Sub

    Damit wäre zumindest rein theoretisch eine parallele Verarbeitung möglich.

    Nur kann VBA halt nicht mehrere Threads parallel fahren.


    Falls du dich zu den VBA-Gurus zählst (was ich aufgrund deines obigen Codes allerdings bezweifle):
    Es gibt einen VonHintenDurchDieBrustInsAugeTrick, der allerdings etwas Programmiererfahrung erfordert.
    Du kannst einem WinApi-Timer eine Callback-Routine aus deinem Code mitgeben. (Stichwort SetTimer)
    Der Clou bei der Sache ist, dass die Abarbeitung der Eventroutine in einem eigenen Thread erfolgt.

    Wenn du genügend Timer aufsetzt, kannst du damit beliebig viele Threads erzeugen.
    Achte aber darauf, dass jeder Timer nur einmal feuert (und am besten beim ersten Feuern wieder gestoppt wird), sonst wirst du von der Parallelität erschlagen.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

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

    Hi petaod!

    Also... Ich zähle mich definitiv NICHT zu den VBA-Gurus - da bin ich noch seeeehhr weit entfernt... ;)

    Aber ich denke ich kann der Grundidee von dir folgen... meinst du folgendes?:

    Ich teile einen Schleifendurchlauf in, sagen wir mal 4 Teile auf... - durch set range...
    Dann erzeuge ich durch SetTimer 4 verschiedene Threads, in dem dann durch eine Rückruffunktion der jeweilige Bereich abgearbeitet wird... --> somit... pro Range, 1 Thread... oder?
    und dadurch könnte ich dann die Arbeit aufteilen und gleichzeitig laufen lassen...

    Hab ich das jz richtig verstanden?




    NACHTRAG:

    Ich habe soeben noch eine andere Herangehensweise aufgeschnappt.... nämlich... dass man ein Addin für Excel über VSTO (Visual Studio for Office) programmieren könnte... denn da hätte ich anscheinend die volle Leistungsfähigkeit von Visual Studio zur Verfügung...

    was haltet ihr von dem Ansatz? würde so was Sinn machen? und vor allem, kann man dadurch erheblich bessere Performanz erreichen??


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

    Hallo,

    ich sehe das Problem eher in dem aktuellen Lösungsweg. Zugriffe auf Zellen dauern wesentlich länger als Zugriffe auf Variablen. Bei solchen 'Monsterberechungen' lade ich alles in Variablen und sperre die Autoberechnung und die Bildschirmaktualisierung. Nachdem ich die Zellen am Ende wieder befüllt habe, schalte ich das wieder ein.

    Plan B:
    So wie ich das verstanden habe, gab es Anfangs mal einige Summen, die wurden dann in Teilbeträge zerlegt und nun versuchst Du per Makro die Teilbeträge wieder zu den Summen zusammenzugruppieren. Da wäre es besser, wenn schon beim Aufteilen irgendwo ein 'GruppenMerker' gesetzt wird.
    Gruß
    Peterfido

    Keine Unterstützung per PN!

    hallo peterfido,

    es ist leider verkehrt rum... man hat als vorgabe einen Gesamtbetrag... und die Teilbeträge kommen wo anders her... haben aber eben einen Zusammenhang... - nämlich das sie möglicherweise teil des Gesamtbetrags sein können...
    und das checke ich damit eben...

    das Problem bei dem ganzen ist leider, dass die Daten eben in Zellen stehen müssen und so, muss jeder Wert erstmals eingelesen werden.... von dem her kann ich da leider nix bzw. nicht noch "mehr" in variablen packen.... :((

    aber danke für deinen vorschlag!

    aber... EINE FRAGE...:
    habe ich eigentlich auch eine Autoberechnung, wenn ich KEINE Formel da stehen habe?? weil sonst, könnte ich das zumindest mal probieren... mit dem Abschalten... ^^ ??

    VG Tim

    Hallo,

    keine Ahnung, nie ausgetestet. Wenn Du mehrere Durchläufe mit immer den selben Zellen hast, dann bringt es in jedem Fall etwas, die Werte in Variablen zwischenzuspeichern und dann damit die mehreren Durchläufe zu machen. Je nach Größe der Summen ist es auch schneller mit Ganzzahlen zu arbeiten. Dafür einfach alles mal 100 nehmen und probieren lassen. Rundungsfehler musst du evtl. progammtechnisch tolerieren. Machnmal fehlt ja am Ende ein Cent, wenn man die Einzelsummern addiert.
    Gruß
    Peterfido

    Keine Unterstützung per PN!

    hmm...

    naja... mal schauen...

    ich werds jz eh mal ausprobieren... bei einem anderen, simpleren Tab.... da lasse ich jz mal alle werte die da stehen in Arrays einlesen und dann arbeite ich damit (lasse was vergleichen....) - ich werde dann auch noch die "normale" variante programmieren.... und dann werde ich mal mit meiner Stoppuhr stoppen... *gggg* - mal schauen, was ich da für einen Performance-Anstieg erhalte.... werde euch noch bescheid geben, wenn ichs fertig habe...

    Frage hierzu.... kann ein Array beliebig groß sein?? gibt's da keine Speicherprobleme, bei großen Datensätzen? - also wenn ich beispielsweise die 1'048'576 Zeilen einlesen lassen möchte.... - theoretisch.... geht das dann, wenn die Länge von meinem Array so groß gewählt wird, oder gibt's da in der Praxis Komplikationen??

    VG Tim

    Hallo,

    wenn Du wirklich über eine Million Beträge zu einer Summe zuordnen möchtest, dann gehe ich davon aus, dass das Ergebnis so oder so nicht stimmen wird. Da werden dann viele Beträge (oder Lösungsmöglichkeiten) mehrfach vorhanden sein. Ansonsten probier es einfach aus. Kann nichts kaputtgehen, wenn Du mit Kopien der Daten testest.
    Gruß
    Peterfido

    Keine Unterstützung per PN!

    hallo,

    danke für eure Ideen...

    wie gesagt... ich teste es jz gerade.... allerdings bei einem anderen Tab, bei dem aber das idente Grundproblem, vom Prinzip her, vorliegt...:

    Man hat 2 Tabellen (Tabs), in welchen Nummern stehen....
    In der ersten befinden sich 22493 Einträge und in der zweiten 22543 Einträge. Wobei in der zweiten duplikate Nummern stehen...
    Es soll nun ein "Delta" ermittelt werden... Somit:
    Es sollen jene Nummern aus der ersten Tabelle ermittelt werden, welche unikat in der zweiten NICHT VORKOMMEN...

    Achja und bevor das alles gemacht wird... müssen die Rohdaten vom Format her erst mal umgewandelt werden, da diese leider nur als Text vorkommen...

    Der Lösungsweg wäre nun der, dass zuerst mal die Daten umgewandelt werden und dann die Kernaufgabe gelöst wird. Dafür, werden die Einträge bei der "herkömmlichen" Methode einfach aus Zeilen eingelesen, in Zeilen geschrieben usw... Somit, wird in den Tabellen drinnen gearbeitet....

    Bei der "schnellen" Methode... wird zuerst mal alles in Arrays eingelesen und dann wird mit den Arrays gearbeitet und am Schluss wird alles einfach ausgegeben, also Sprich, in die Zeilen geschrieben....

    Für diese Vorgänge wird eben die Zeit gestoppt...

    Ich mache also 4 Testdurchläufe:

    1.) Test der "herkömmlichen" Methode, OHNE DEAKTIVIERUNG des ScreenUpdates und der automatischen Berechnung
    2.) Test der "herkömmlichen" Methode, MIT DEAKTIVIERUNG des ScreenUpdates und der automatischen Berechnung
    3.) Test der Array-Methode, OHNE DEAKTIVIERUNG des ScreenUpdates und der automatischen Berechnung
    4.) Test der Array-Methode, MIT DEAKTIVIERUNG des ScreenUpdates und der automatischen Berechnung

    Also ich bin mal gespannt was da rauskommen wird...
    Ich lasse es euch wissen, weil falls es signifikante Unterschiede gäbe, ist ja mal ganz gut, dass man so was dokumentiert... ;)

    Mal ein ganz anderer Anstoss - willst Du vielleicht nicht explizit so hören, würde aber Dein Problem lösen:

    Wenn Du die Daten ohnehin erst aus Textdateien einlesen musst dann nimm doch gleich eine Datenbank! Excel ist nun mal nicht für solche DAtenmengen geschaffen. Und das was Du hier umständlich und zeitaufwendig programmierst das kann im Wesentlichen eine Datenbank mit Bordmitteln und wesentlich performanter als Excel erledigen.
    Am einfachsten für dich wäre vermutlich MS Access, das ist zwar auch nicht DIE Datenbank aber mit der genannten Menge an Daten kommt es noch locker zurecht und du müsstest dich nicht weiter umgewöhnen da Access auch VBA verwendet.

    Das nur mal am Rande...

    Es sieht so aus, als würdest Du irgendwie Duplikate suchen. Da kann man in Excel mit der Funktion 'Duplikate entfernen' oder der 'bedingten Formatierung' operieren (funktioniert ziemlich schnell) . Etwas versteckter ist der 'Zeilenvergleich' über 2 markierten Spalten. Mal so als Denkanstoß...Wenn das als Methode irgendwie klar ist, kann man später versuchen, das in VBA umzusetzen.

    hi Thisoft...

    naja.. so ist es ja nicht... ich habe meine Rohdaten als Excel Tabelle... Mir ist schon klar, dass ich das auch im Access lösen könnte... nur... das Problem bei dem Ganzen ist:
    das ich damals als Grundlage Excel gewählt habe. Wenn ich jz anfange Teile davon ins Access auszulagern, dann kann ich eigentlich gleich hergehen und das komplette Ding NEU in Access programmieren... und bevor ich das wirklich mache... muss ich erst mal alle anderen Möglichkeiten abwägen und prüfen... weil... dieses Fass aufzumachen wäre nur denkbar wenn nix anderes dran vorbeiführt...
    Excel bietet mir generell, bis auf die Performanz bei wirklich großen Datensätzen, alles was ich brauche... und das wesentlich unkomplizierter als Access...

    @oliver3121
    Ja das ist mir schon klar, dass es diese Funktion gibt... - die wende ich ja auch schon bereits an... ;)
    aber danke für den Tipp! - ich werde später dann eh meinen code posten, wenn ich die testläufe fertig habe... ;)

    VG Tim







    ERGEBNIS:

    So Leute... Jz ist's soweit.. und ich muss ehrlich sagen ich bin sprachlos (im positiven Sinne...)!!

    Hier zunächst mal der CODE:

    "Herkömmliche Methode" - FALL 1:
    Spoiler anzeigen

    Visual Basic-Quellcode

    1. Private Sub CommandButton3_Click()
    3. Dim a As Long
    4. Dim b As Long
    5. Dim zeilenmax_tab2 As Long
    6. Dim zeilenmax_tab3 As Long
    7. Dim Aufnr_tab2 As Long
    8. Dim Aufnr_tab3 As Long
    9. Dim kz_gefunden As Boolean
    10. Dim zeilenmax_hsp As Long
    11. Dim indx As Long
    12. Dim kz_LVexistiert As Boolean
    14. 'Schalte automatische Berechnung aus...
    15. 'Application.Calculation = xlCalculationManual
    16. 'Schalte automatische Bildschirmaktualisierung aus...
    17. 'Application.ScreenUpdating = False
    19. 'Lösche Inhalt...
    20. Tabelle4.Range(Tabelle4.Cells(2, 4), Tabelle4.Cells(1048576, 4)).ClearContents
    22. zeilenmax_tab2 = Tabelle2.Cells(Rows.Count, 10).End(xlUp).Row
    23. zeilenmax_tab3 = Tabelle3.Cells(Rows.Count, 1).End(xlUp).Row
    25. 'Umwandeln der Auftragsnummern, usw. von Text in Zahl von Tabelle 2
    26. 'und... Kontrolle ob ein Auftrag mit Löschvormerkung existiert...
    27. For a = 2 To zeilenmax_tab2
    28. If Tabelle2.Cells(a, 3) <> "" Then
    29. 'Planungswerk von Text in Zahl umwandeln...
    30. Tabelle2.Cells(a, 3).Value = Tabelle2.Cells(a, 3) * 1
    31. Else
    32. End If
    33. If Tabelle2.Cells(a, 4) <> "" Then
    34. 'Planergruppe von Text in Zahl umwandeln...
    35. Tabelle2.Cells(a, 4).Value = Tabelle2.Cells(a, 4) * 1
    36. Else
    37. End If
    38. If Tabelle2.Cells(a, 5) <> "" Then
    39. 'Kostenstelle von Text in Zahl umwandeln...
    40. Tabelle2.Cells(a, 5).Value = Tabelle2.Cells(a, 5) * 1
    41. Else
    42. End If
    43. If Tabelle2.Cells(a, 6) <> "" Then
    44. 'Verantwortliche Kostenstelle von Text in Zahl umwandeln...
    45. Tabelle2.Cells(a, 6).Value = Tabelle2.Cells(a, 6) * 1
    46. Else
    47. End If
    48. If Tabelle2.Cells(a, 7) <> "" Then
    49. 'Equipment von Text in Zahl umwandeln...
    50. Tabelle2.Cells(a, 7).Value = Tabelle2.Cells(a, 7) * 1
    51. Else
    52. End If
    53. If Tabelle2.Cells(a, 10) <> "" Then
    54. 'Auftragsnummern von Text in Zahl umwandeln...
    55. Tabelle2.Cells(a, 10).Value = Tabelle2.Cells(a, 10) * 1
    56. Else
    57. End If
    58. If Tabelle2.Cells(a, 2) <> "" Then
    59. kz_LVexistiert = True
    60. Else
    61. End If
    62. Next
    64. 'Umwandeln der Auftragsnummern, usw. von Text in Zahl von Tabelle 3
    65. For b = 2 To zeilenmax_tab3
    66. If Tabelle3.Cells(b, 1) <> "" Then
    67. 'Auftragsnummern von Text in Zahl umwandeln...
    68. Tabelle3.Cells(b, 1).Value = Tabelle3.Cells(b, 1) * 1
    69. Else
    70. End If
    71. If Tabelle3.Cells(b, 2) <> "" Then
    72. 'Jahr von Text in Zahl umwandeln...
    73. Tabelle3.Cells(b, 2).Value = Tabelle3.Cells(b, 2) * 1
    74. Else
    75. End If
    76. If Tabelle3.Cells(b, 3) <> "" Then
    77. 'Werttyp von Text in Zahl umwandeln...
    78. Tabelle3.Cells(b, 3).Value = Tabelle3.Cells(b, 3) * 1
    79. Else
    80. End If
    81. Next
    83. 'Kopieren in Hilfsspalte...
    84. Tabelle3.Cells(1, 52).Value = "Hilfsspalte für unikate Darstellung:"
    85. For b = 2 To zeilenmax_tab3
    86. Tabelle3.Cells(b, 52).Value = Tabelle3.Cells(b, 1)
    87. Next
    88. Tabelle3.Range(Tabelle3.Cells(2, 52), Tabelle3.Cells(zeilenmax_tab3, 52)).RemoveDuplicates Columns:=1, Header:=xlNo
    90. zeilenmax_hsp = Tabelle3.Cells(Rows.Count, 52).End(xlUp).Row
    92. For a = 2 To zeilenmax_tab2
    93. Aufnr_tab2 = Tabelle2.Cells(a, 10)
    94. For b = 2 To zeilenmax_hsp
    95. Aufnr_tab3 = Tabelle2.Cells(b, 10)
    96. If Aufnr_tab3 = Aufnr_tab2 Then
    97. kz_gefunden = True
    98. Exit For
    99. Else
    100. End If
    101. Next
    102. If kz_gefunden = False Then
    103. indx = Tabelle4.Cells(Rows.Count, 4).End(xlUp).Row + 1
    104. Tabelle4.Cells(indx, 4).Value = Aufnr_tab2
    105. Else
    106. End If
    107. kz_gefunden = False
    108. Next
    110. 'Löschen der Hilfsspalte
    111. Tabelle3.Range(Tabelle3.Cells(1, 52), Tabelle3.Cells(1048576, 52)).ClearContents
    113. 'Schalte automatische Berechnung wieder ein...
    114. 'Application.Calculation = xlCalculationAutomatic
    115. 'Schalte automatische Bildschirmaktualisierung wieder ein...
    116. 'Application.ScreenUpdating = True
    118. If kz_LVexistiert = True Then
    119. MsgBox ("Schritt 1:" & vbNewLine & vbNewLine & "Vorgang ausgeführt! - ABER, ACHTUNG!! - Es existiert mind. 1 Eintrag im Tab: '1 - Alle Aufträge zu Equipments', welcher einen Löschvormerk aufweist!! --> Daher:" & vbNewLine & vbNewLine & "Manuelle Überprüfung notwendig!!"), vbOKOnly
    120. Else
    121. MsgBox ("Schritt 1:" & vbNewLine & vbNewLine & "Vorgang erfolgreich ausgeführt!"), vbOKOnly
    122. End If
    124. End Sub



    Dann die Optimierung von diesem Code indem man ScreenUpdate und die autom. Berechnung deaktiviert und dann wieder aktiviert:

    "Herkömmliche Methode" mit Deaktivierung der autom. Berechnung und des ScreenUpdates - FALL 2:
    Spoiler anzeigen

    Visual Basic-Quellcode

    1. Private Sub CommandButton3_Click()
    3. Dim a As Long
    4. Dim b As Long
    5. Dim zeilenmax_tab2 As Long
    6. Dim zeilenmax_tab3 As Long
    7. Dim Aufnr_tab2 As Long
    8. Dim Aufnr_tab3 As Long
    9. Dim kz_gefunden As Boolean
    10. Dim zeilenmax_hsp As Long
    11. Dim indx As Long
    12. Dim kz_LVexistiert As Boolean
    14. 'Schalte automatische Berechnung aus...
    15. Application.Calculation = xlCalculationManual
    16. 'Schalte automatische Bildschirmaktualisierung aus...
    17. Application.ScreenUpdating = False
    19. 'Lösche Inhalt...
    20. Tabelle4.Range(Tabelle4.Cells(2, 4), Tabelle4.Cells(1048576, 4)).ClearContents
    22. zeilenmax_tab2 = Tabelle2.Cells(Rows.Count, 10).End(xlUp).Row
    23. zeilenmax_tab3 = Tabelle3.Cells(Rows.Count, 1).End(xlUp).Row
    25. 'Umwandeln der Auftragsnummern, usw. von Text in Zahl von Tabelle 2
    26. 'und... Kontrolle ob ein Auftrag mit Löschvormerkung existiert...
    27. For a = 2 To zeilenmax_tab2
    28. If Tabelle2.Cells(a, 3) <> "" Then
    29. 'Planungswerk von Text in Zahl umwandeln...
    30. Tabelle2.Cells(a, 3).Value = Tabelle2.Cells(a, 3) * 1
    31. Else
    32. End If
    33. If Tabelle2.Cells(a, 4) <> "" Then
    34. 'Planergruppe von Text in Zahl umwandeln...
    35. Tabelle2.Cells(a, 4).Value = Tabelle2.Cells(a, 4) * 1
    36. Else
    37. End If
    38. If Tabelle2.Cells(a, 5) <> "" Then
    39. 'Kostenstelle von Text in Zahl umwandeln...
    40. Tabelle2.Cells(a, 5).Value = Tabelle2.Cells(a, 5) * 1
    41. Else
    42. End If
    43. If Tabelle2.Cells(a, 6) <> "" Then
    44. 'Verantwortliche Kostenstelle von Text in Zahl umwandeln...
    45. Tabelle2.Cells(a, 6).Value = Tabelle2.Cells(a, 6) * 1
    46. Else
    47. End If
    48. If Tabelle2.Cells(a, 7) <> "" Then
    49. 'Equipment von Text in Zahl umwandeln...
    50. Tabelle2.Cells(a, 7).Value = Tabelle2.Cells(a, 7) * 1
    51. Else
    52. End If
    53. If Tabelle2.Cells(a, 10) <> "" Then
    54. 'Auftragsnummern von Text in Zahl umwandeln...
    55. Tabelle2.Cells(a, 10).Value = Tabelle2.Cells(a, 10) * 1
    56. Else
    57. End If
    58. If Tabelle2.Cells(a, 2) <> "" Then
    59. kz_LVexistiert = True
    60. Else
    61. End If
    62. Next
    64. 'Umwandeln der Auftragsnummern, usw. von Text in Zahl von Tabelle 3
    65. For b = 2 To zeilenmax_tab3
    66. If Tabelle3.Cells(b, 1) <> "" Then
    67. 'Auftragsnummern von Text in Zahl umwandeln...
    68. Tabelle3.Cells(b, 1).Value = Tabelle3.Cells(b, 1) * 1
    69. Else
    70. End If
    71. If Tabelle3.Cells(b, 2) <> "" Then
    72. 'Jahr von Text in Zahl umwandeln...
    73. Tabelle3.Cells(b, 2).Value = Tabelle3.Cells(b, 2) * 1
    74. Else
    75. End If
    76. If Tabelle3.Cells(b, 3) <> "" Then
    77. 'Werttyp von Text in Zahl umwandeln...
    78. Tabelle3.Cells(b, 3).Value = Tabelle3.Cells(b, 3) * 1
    79. Else
    80. End If
    81. Next
    83. 'Kopieren in Hilfsspalte...
    84. Tabelle3.Cells(1, 52).Value = "Hilfsspalte für unikate Darstellung:"
    85. For b = 2 To zeilenmax_tab3
    86. Tabelle3.Cells(b, 52).Value = Tabelle3.Cells(b, 1)
    87. Next
    88. Tabelle3.Range(Tabelle3.Cells(2, 52), Tabelle3.Cells(zeilenmax_tab3, 52)).RemoveDuplicates Columns:=1, Header:=xlNo
    90. zeilenmax_hsp = Tabelle3.Cells(Rows.Count, 52).End(xlUp).Row
    92. For a = 2 To zeilenmax_tab2
    93. Aufnr_tab2 = Tabelle2.Cells(a, 10)
    94. For b = 2 To zeilenmax_hsp
    95. Aufnr_tab3 = Tabelle2.Cells(b, 10)
    96. If Aufnr_tab3 = Aufnr_tab2 Then
    97. kz_gefunden = True
    98. Exit For
    99. Else
    100. End If
    101. Next
    102. If kz_gefunden = False Then
    103. indx = Tabelle4.Cells(Rows.Count, 4).End(xlUp).Row + 1
    104. Tabelle4.Cells(indx, 4).Value = Aufnr_tab2
    105. Else
    106. End If
    107. kz_gefunden = False
    108. Next
    110. 'Löschen der Hilfsspalte
    111. Tabelle3.Range(Tabelle3.Cells(1, 52), Tabelle3.Cells(1048576, 52)).ClearContents
    113. 'Schalte automatische Berechnung wieder ein...
    114. Application.Calculation = xlCalculationAutomatic
    115. 'Schalte automatische Bildschirmaktualisierung wieder ein...
    116. Application.ScreenUpdating = True
    118. If kz_LVexistiert = True Then
    119. MsgBox ("Schritt 1:" & vbNewLine & vbNewLine & "Vorgang ausgeführt! - ABER, ACHTUNG!! - Es existiert mind. 1 Eintrag im Tab: '1 - Alle Aufträge zu Equipments', welcher einen Löschvormerk aufweist!! --> Daher:" & vbNewLine & vbNewLine & "Manuelle Überprüfung notwendig!!"), vbOKOnly
    120. Else
    121. MsgBox ("Schritt 1:" & vbNewLine & vbNewLine & "Vorgang erfolgreich ausgeführt!"), vbOKOnly
    122. End If
    124. End Sub



    Dann die Umsetzung mit Arrays...

    "Array Code" OHNE Deaktivierung von autom. Berechnung und ScreenUpdate - FALL 3:
    Spoiler anzeigen

    Visual Basic-Quellcode

    1. Private Sub CommandButton2_Click()
    2. 'Button:
    4. Dim zeilenmax_tab2 As Long
    5. Dim zeilenmax_tab3 As Long
    6. Dim a As Long
    7. Dim b As Long
    8. Dim c As Long
    9. Dim d As Long
    10. Dim MaxLängeArray_tab2 As Long
    11. Dim MaxLängeArray_tab3 As Long
    12. Dim kz_LVexistiert As Boolean
    13. Dim Array_AUFNR_tab2() As Long
    14. Dim Array_AUFNR_tab3() As Long
    15. Dim zeilenmax_tab3_hilfsspalte As Long
    16. Dim arrayindex As Long
    17. Dim ErgebnisArray() As Long
    18. Dim arrayindex_1 As Long
    19. Dim arrayindex_2 As Long
    20. Dim KommtVor As Boolean
    21. Dim DifferenzAnzahl As Long
    22. Dim arrayindex_ergebnisarray As Long
    23. Dim Aufnr_aktuell_arrayTab2 As Long
    24. Dim Aufnr_aktuell_arrayTab3 As Long
    25. Dim Index As Long
    26. Dim indx As Long
    28. 'Schalte automatische Berechnung aus...
    29. 'Application.Calculation = xlCalculationManual
    30. 'Schalte automatische Bildschirmaktualisierung aus...
    31. 'Application.ScreenUpdating = False
    33. 'Lösche Inhalt...
    34. Tabelle4.Range(Tabelle4.Cells(2, 4), Tabelle4.Cells(1048576, 4)).ClearContents
    36. zeilenmax_tab2 = Tabelle2.Cells(Rows.Count, 10).End(xlUp).Row
    37. zeilenmax_tab3 = Tabelle3.Cells(Rows.Count, 1).End(xlUp).Row
    39. 'Umwandeln der Auftragsnummern, usw. von Text in Zahl von Tabelle 2
    40. 'und... Kontrolle ob ein Auftrag mit Löschvormerkung existiert...
    41. For a = 2 To zeilenmax_tab2
    42. If Tabelle2.Cells(a, 3) <> "" Then
    43. 'Planungswerk von Text in Zahl umwandeln...
    44. Tabelle2.Cells(a, 3).Value = Tabelle2.Cells(a, 3) * 1
    45. Else
    46. End If
    47. If Tabelle2.Cells(a, 4) <> "" Then
    48. 'Planergruppe von Text in Zahl umwandeln...
    49. Tabelle2.Cells(a, 4).Value = Tabelle2.Cells(a, 4) * 1
    50. Else
    51. End If
    52. If Tabelle2.Cells(a, 5) <> "" Then
    53. 'Kostenstelle von Text in Zahl umwandeln...
    54. Tabelle2.Cells(a, 5).Value = Tabelle2.Cells(a, 5) * 1
    55. Else
    56. End If
    57. If Tabelle2.Cells(a, 6) <> "" Then
    58. 'Verantwortliche Kostenstelle von Text in Zahl umwandeln...
    59. Tabelle2.Cells(a, 6).Value = Tabelle2.Cells(a, 6) * 1
    60. Else
    61. End If
    62. If Tabelle2.Cells(a, 7) <> "" Then
    63. 'Equipment von Text in Zahl umwandeln...
    64. Tabelle2.Cells(a, 7).Value = Tabelle2.Cells(a, 7) * 1
    65. Else
    66. End If
    67. If Tabelle2.Cells(a, 10) <> "" Then
    68. 'Auftragsnummern von Text in Zahl umwandeln...
    69. Tabelle2.Cells(a, 10).Value = Tabelle2.Cells(a, 10) * 1
    70. Else
    71. End If
    72. If Tabelle2.Cells(a, 2) <> "" Then
    73. kz_LVexistiert = True
    74. Else
    75. End If
    76. Next
    78. 'Umwandeln der Auftragsnummern, usw. von Text in Zahl von Tabelle 3
    79. For b = 2 To zeilenmax_tab3
    80. If Tabelle3.Cells(b, 1) <> "" Then
    81. 'Auftragsnummern von Text in Zahl umwandeln...
    82. Tabelle3.Cells(b, 1).Value = Tabelle3.Cells(b, 1) * 1
    83. Else
    84. End If
    85. If Tabelle3.Cells(b, 2) <> "" Then
    86. 'Jahr von Text in Zahl umwandeln...
    87. Tabelle3.Cells(b, 2).Value = Tabelle3.Cells(b, 2) * 1
    88. Else
    89. End If
    90. If Tabelle3.Cells(b, 3) <> "" Then
    91. 'Werttyp von Text in Zahl umwandeln...
    92. Tabelle3.Cells(b, 3).Value = Tabelle3.Cells(b, 3) * 1
    93. Else
    94. End If
    95. Next
    97. 'Einlesen aller Auftragsnummern und befüllen, des Arrays für Tabelle 2
    98. MaxLängeArray_tab2 = zeilenmax_tab2 - 1
    99. ReDim Array_AUFNR_tab2(1 To MaxLängeArray_tab2)
    100. arrayindex = 1
    101. For a = 2 To zeilenmax_tab2
    102. Array_AUFNR_tab2(arrayindex) = Tabelle2.Cells(a, 10)
    103. arrayindex = arrayindex + 1
    104. Next
    106. 'Kopieren der Auftragsnummern in die Hilfsspalte "AZ" in Tabelle 3
    107. 'Überschrift von AZ:
    108. Tabelle3.Cells(1, 52).Value = "Hilfsspalte (Unikate für Array...):"
    109. 'Kopieren der Auftragsnummern:
    110. For b = 2 To zeilenmax_tab3
    111. Tabelle3.Cells(b, 52).Value = Tabelle3.Cells(b, 1)
    112. Next
    113. Tabelle3.Range(Tabelle3.Cells(2, 52), Tabelle3.Cells(zeilenmax_tab3, 52)).RemoveDuplicates Columns:=1, Header:=xlNo
    115. 'Einlesen aller Auftragsnummern und befüllen, des Arrays für Tabelle 3
    116. zeilenmax_tab3_hilfsspalte = Tabelle3.Cells(Rows.Count, 52).End(xlUp).Row
    117. MaxLängeArray_tab3 = zeilenmax_tab3_hilfsspalte - 1
    118. ReDim Array_AUFNR_tab3(1 To MaxLängeArray_tab3)
    119. arrayindex = 1
    120. For b = 2 To zeilenmax_tab3_hilfsspalte
    121. Array_AUFNR_tab3(arrayindex) = Tabelle3.Cells(b, 52)
    122. arrayindex = arrayindex + 1
    123. Next
    125. 'Löschen der Hilfsspalte...
    126. Tabelle3.Range(Tabelle3.Cells(1, 52), Tabelle3.Cells(1048576, 52)).ClearContents
    128. 'Schau ob Auftragsnummer von Array für Tabelle 2 in Array für Tabelle 3 vorkommt...
    129. arrayindex_1 = 1
    130. arrayindex_2 = 1
    131. KommtVor = False
    132. 'Initial wird die Größe vom ErgebnisArray als DifferenzAnzahl von Einträgen von Tab2 zu UNIKATEN Einträgen von Tab3 dimensioniert...
    133. DifferenzAnzahl = zeilenmax_tab2 - zeilenmax_tab3_hilfsspalte
    134. ReDim ErgebnisArray(1 To DifferenzAnzahl)
    135. arrayindex_ergebnisarray = 1
    136. For c = 1 To MaxLängeArray_tab2
    137. Aufnr_aktuell_arrayTab2 = Array_AUFNR_tab2(arrayindex_1)
    138. For d = 1 To MaxLängeArray_tab3
    139. Aufnr_aktuell_arrayTab3 = Array_AUFNR_tab3(arrayindex_2)
    140. If Aufnr_aktuell_arrayTab3 = Aufnr_aktuell_arrayTab2 Then
    141. KommtVor = True
    142. Exit For
    143. Else
    144. arrayindex_2 = arrayindex_2 + 1
    145. End If
    146. Next
    147. 'Falls VBA den ganzen Schleifendurchgang von "For d = 1 To MaxLängeArray_tab3" nix gefunden haben sollte....
    148. 'schreibe die betroffenen Auftragsnummern in ein ErgebnisArray
    149. If KommtVor = False Then
    150. ErgebnisArray(arrayindex_ergebnisarray) = Aufnr_aktuell_arrayTab2
    151. arrayindex_ergebnisarray = arrayindex_ergebnisarray + 1
    152. Else
    153. End If
    154. arrayindex_1 = arrayindex_1 + 1
    155. arrayindex_2 = 1
    156. KommtVor = False
    157. Next
    159. 'Ausgabe der betroffenen Auftragsnummern...
    160. For Index = 1 To DifferenzAnzahl
    161. indx = Tabelle4.Cells(Rows.Count, 4).End(xlUp).Row + 1
    162. Tabelle4.Cells(indx, 4).Value = ErgebnisArray(Index)
    163. Next
    165. 'Schalte automatische Berechnung wieder ein...
    166. 'Application.Calculation = xlCalculationAutomatic
    167. 'Schalte automatische Bildschirmaktualisierung wieder ein...
    168. 'Application.ScreenUpdating = True
    170. If kz_LVexistiert = True Then
    171. MsgBox ("Schritt 1:" & vbNewLine & vbNewLine & "Vorgang ausgeführt! - ABER, ACHTUNG!! - Es existiert mind. 1 Eintrag im Tab: '1 - Alle Aufträge zu Equipments', welcher einen Löschvormerk aufweist!! --> Daher:" & vbNewLine & vbNewLine & "Manuelle Überprüfung notwendig!!"), vbOKOnly
    172. Else
    173. MsgBox ("Schritt 1:" & vbNewLine & vbNewLine & "Vorgang erfolgreich ausgeführt!"), vbOKOnly
    174. End If
    176. End Sub



    "Array Code" MIT Deaktivierung von autom. Berechnung und ScreenUpdate - FALL 4:
    Spoiler anzeigen

    Visual Basic-Quellcode

    1. Private Sub CommandButton2_Click()
    2. 'Button:
    4. Dim zeilenmax_tab2 As Long
    5. Dim zeilenmax_tab3 As Long
    6. Dim a As Long
    7. Dim b As Long
    8. Dim c As Long
    9. Dim d As Long
    10. Dim MaxLängeArray_tab2 As Long
    11. Dim MaxLängeArray_tab3 As Long
    12. Dim kz_LVexistiert As Boolean
    13. Dim Array_AUFNR_tab2() As Long
    14. Dim Array_AUFNR_tab3() As Long
    15. Dim zeilenmax_tab3_hilfsspalte As Long
    16. Dim arrayindex As Long
    17. Dim ErgebnisArray() As Long
    18. Dim arrayindex_1 As Long
    19. Dim arrayindex_2 As Long
    20. Dim KommtVor As Boolean
    21. Dim DifferenzAnzahl As Long
    22. Dim arrayindex_ergebnisarray As Long
    23. Dim Aufnr_aktuell_arrayTab2 As Long
    24. Dim Aufnr_aktuell_arrayTab3 As Long
    25. Dim Index As Long
    26. Dim indx As Long
    28. 'Schalte automatische Berechnung aus...
    29. Application.Calculation = xlCalculationManual
    30. 'Schalte automatische Bildschirmaktualisierung aus...
    31. Application.ScreenUpdating = False
    33. 'Lösche Inhalt...
    34. Tabelle4.Range(Tabelle4.Cells(2, 4), Tabelle4.Cells(1048576, 4)).ClearContents
    36. zeilenmax_tab2 = Tabelle2.Cells(Rows.Count, 10).End(xlUp).Row
    37. zeilenmax_tab3 = Tabelle3.Cells(Rows.Count, 1).End(xlUp).Row
    39. 'Umwandeln der Auftragsnummern, usw. von Text in Zahl von Tabelle 2
    40. 'und... Kontrolle ob ein Auftrag mit Löschvormerkung existiert...
    41. For a = 2 To zeilenmax_tab2
    42. If Tabelle2.Cells(a, 3) <> "" Then
    43. 'Planungswerk von Text in Zahl umwandeln...
    44. Tabelle2.Cells(a, 3).Value = Tabelle2.Cells(a, 3) * 1
    45. Else
    46. End If
    47. If Tabelle2.Cells(a, 4) <> "" Then
    48. 'Planergruppe von Text in Zahl umwandeln...
    49. Tabelle2.Cells(a, 4).Value = Tabelle2.Cells(a, 4) * 1
    50. Else
    51. End If
    52. If Tabelle2.Cells(a, 5) <> "" Then
    53. 'Kostenstelle von Text in Zahl umwandeln...
    54. Tabelle2.Cells(a, 5).Value = Tabelle2.Cells(a, 5) * 1
    55. Else
    56. End If
    57. If Tabelle2.Cells(a, 6) <> "" Then
    58. 'Verantwortliche Kostenstelle von Text in Zahl umwandeln...
    59. Tabelle2.Cells(a, 6).Value = Tabelle2.Cells(a, 6) * 1
    60. Else
    61. End If
    62. If Tabelle2.Cells(a, 7) <> "" Then
    63. 'Equipment von Text in Zahl umwandeln...
    64. Tabelle2.Cells(a, 7).Value = Tabelle2.Cells(a, 7) * 1
    65. Else
    66. End If
    67. If Tabelle2.Cells(a, 10) <> "" Then
    68. 'Auftragsnummern von Text in Zahl umwandeln...
    69. Tabelle2.Cells(a, 10).Value = Tabelle2.Cells(a, 10) * 1
    70. Else
    71. End If
    72. If Tabelle2.Cells(a, 2) <> "" Then
    73. kz_LVexistiert = True
    74. Else
    75. End If
    76. Next
    78. 'Umwandeln der Auftragsnummern, usw. von Text in Zahl von Tabelle 3
    79. For b = 2 To zeilenmax_tab3
    80. If Tabelle3.Cells(b, 1) <> "" Then
    81. 'Auftragsnummern von Text in Zahl umwandeln...
    82. Tabelle3.Cells(b, 1).Value = Tabelle3.Cells(b, 1) * 1
    83. Else
    84. End If
    85. If Tabelle3.Cells(b, 2) <> "" Then
    86. 'Jahr von Text in Zahl umwandeln...
    87. Tabelle3.Cells(b, 2).Value = Tabelle3.Cells(b, 2) * 1
    88. Else
    89. End If
    90. If Tabelle3.Cells(b, 3) <> "" Then
    91. 'Werttyp von Text in Zahl umwandeln...
    92. Tabelle3.Cells(b, 3).Value = Tabelle3.Cells(b, 3) * 1
    93. Else
    94. End If
    95. Next
    97. 'Einlesen aller Auftragsnummern und befüllen, des Arrays für Tabelle 2
    98. MaxLängeArray_tab2 = zeilenmax_tab2 - 1
    99. ReDim Array_AUFNR_tab2(1 To MaxLängeArray_tab2)
    100. arrayindex = 1
    101. For a = 2 To zeilenmax_tab2
    102. Array_AUFNR_tab2(arrayindex) = Tabelle2.Cells(a, 10)
    103. arrayindex = arrayindex + 1
    104. Next
    106. 'Kopieren der Auftragsnummern in die Hilfsspalte "AZ" in Tabelle 3
    107. 'Überschrift von AZ:
    108. Tabelle3.Cells(1, 52).Value = "Hilfsspalte (Unikate für Array...):"
    109. 'Kopieren der Auftragsnummern:
    110. For b = 2 To zeilenmax_tab3
    111. Tabelle3.Cells(b, 52).Value = Tabelle3.Cells(b, 1)
    112. Next
    113. Tabelle3.Range(Tabelle3.Cells(2, 52), Tabelle3.Cells(zeilenmax_tab3, 52)).RemoveDuplicates Columns:=1, Header:=xlNo
    115. 'Einlesen aller Auftragsnummern und befüllen, des Arrays für Tabelle 3
    116. zeilenmax_tab3_hilfsspalte = Tabelle3.Cells(Rows.Count, 52).End(xlUp).Row
    117. MaxLängeArray_tab3 = zeilenmax_tab3_hilfsspalte - 1
    118. ReDim Array_AUFNR_tab3(1 To MaxLängeArray_tab3)
    119. arrayindex = 1
    120. For b = 2 To zeilenmax_tab3_hilfsspalte
    121. Array_AUFNR_tab3(arrayindex) = Tabelle3.Cells(b, 52)
    122. arrayindex = arrayindex + 1
    123. Next
    125. 'Löschen der Hilfsspalte...
    126. Tabelle3.Range(Tabelle3.Cells(1, 52), Tabelle3.Cells(1048576, 52)).ClearContents
    128. 'Schau ob Auftragsnummer von Array für Tabelle 2 in Array für Tabelle 3 vorkommt...
    129. arrayindex_1 = 1
    130. arrayindex_2 = 1
    131. KommtVor = False
    132. 'Initial wird die Größe vom ErgebnisArray als DifferenzAnzahl von Einträgen von Tab2 zu UNIKATEN Einträgen von Tab3 dimensioniert...
    133. DifferenzAnzahl = zeilenmax_tab2 - zeilenmax_tab3_hilfsspalte
    134. ReDim ErgebnisArray(1 To DifferenzAnzahl)
    135. arrayindex_ergebnisarray = 1
    136. For c = 1 To MaxLängeArray_tab2
    137. Aufnr_aktuell_arrayTab2 = Array_AUFNR_tab2(arrayindex_1)
    138. For d = 1 To MaxLängeArray_tab3
    139. Aufnr_aktuell_arrayTab3 = Array_AUFNR_tab3(arrayindex_2)
    140. If Aufnr_aktuell_arrayTab3 = Aufnr_aktuell_arrayTab2 Then
    141. KommtVor = True
    142. Exit For
    143. Else
    144. arrayindex_2 = arrayindex_2 + 1
    145. End If
    146. Next
    147. 'Falls VBA den ganzen Schleifendurchgang von "For d = 1 To MaxLängeArray_tab3" nix gefunden haben sollte....
    148. 'schreibe die betroffenen Auftragsnummern in ein ErgebnisArray
    149. If KommtVor = False Then
    150. ErgebnisArray(arrayindex_ergebnisarray) = Aufnr_aktuell_arrayTab2
    151. arrayindex_ergebnisarray = arrayindex_ergebnisarray + 1
    152. Else
    153. End If
    154. arrayindex_1 = arrayindex_1 + 1
    155. arrayindex_2 = 1
    156. KommtVor = False
    157. Next
    159. 'Ausgabe der betroffenen Auftragsnummern...
    160. For Index = 1 To DifferenzAnzahl
    161. indx = Tabelle4.Cells(Rows.Count, 4).End(xlUp).Row + 1
    162. Tabelle4.Cells(indx, 4).Value = ErgebnisArray(Index)
    163. Next
    165. 'Schalte automatische Berechnung wieder ein...
    166. Application.Calculation = xlCalculationAutomatic
    167. 'Schalte automatische Bildschirmaktualisierung wieder ein...
    168. Application.ScreenUpdating = True
    170. If kz_LVexistiert = True Then
    171. MsgBox ("Schritt 1:" & vbNewLine & vbNewLine & "Vorgang ausgeführt! - ABER, ACHTUNG!! - Es existiert mind. 1 Eintrag im Tab: '1 - Alle Aufträge zu Equipments', welcher einen Löschvormerk aufweist!! --> Daher:" & vbNewLine & vbNewLine & "Manuelle Überprüfung notwendig!!"), vbOKOnly
    172. Else
    173. MsgBox ("Schritt 1:" & vbNewLine & vbNewLine & "Vorgang erfolgreich ausgeführt!"), vbOKOnly
    174. End If
    176. End Sub




    So... Ich habe alle 4 Fälle unter gleichen Bedingungen getestet und das waren die Zeiten:

    Welcher Fall?:
    		gemessene Zeit:
    FALL 1
    		47 min, 4 sec., 58 hund.sec
    FALL 2
    		12 min, 57 sec., 93 hund.sec
    FALL 3
    		35 min, 49 sec., 85 hund.sec
    FALL 4
    		1 min, 28 sec., 63 hund.sec

    Übrigens:
    Tabelle2 hatte 22493 unikate Einträge...
    und
    Tabelle3 hatte 17115 unikate Einträge...

    Somit mussten bei jedem einzelnen Eintrag von Tabelle2, jedes mal, im schlimmsten Fall, die 17115 Einträge von Tabelle 3 durchgegangen werden.... - außer natürlich, der gewünschte Eintrag wurde schon früher gefunden --> "Exit For" (z.b. FALL 3, Zeile: 142 )

    Also nur damit ihr eine Größenvorstellung habts... ;)

    Also ihr seht bei FALL4, wenn man also mit Arrays arbeitet und noch die ScreenUpdates und die AutoCalc abschaltet und am Schluss wieder einschaltet dauert das nur mehr ca. 1,5 Minuten!! Wahnsinn!! :thumbsup:
    Im Vergleich zum FALL 1, ist das eine Geschwindigkeitssteigerung von unglaublichen 96,88%!!

    Also meiner Meinung nach auf jeden Fall signifikant mehr...

    Ich werde somit mal probieren, mein komplettes Projekt dahin gehend, so gut wie nur möglich zu optimieren...!

    VG Tim

    Dieser Beitrag wurde bereits 7 mal editiert, zuletzt von „ereza“ ()

    Hallo,

    deswegen mache ich das bei größeren Datenmengen schon eine Zeit lang so. Ich fange evtl. Fehler noch ab, so dass wenigstens Screenupdate und Berechnung wieder eingeschaltet werden.
    Gruß
    Peterfido

    Keine Unterstützung per PN!

Facebook
Telefonspende