Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 10:46:47
Bestimmte Zellen aus dynamischer Liste zurückgeben
19.04.2024 10:39:36
Schaltfläche auf einem Tabellenblatt NICHT mit abspeichern
19.04.2024 09:26:26
Median für Zeilen mit gleichen Zeitstempel
19.04.2024 08:41:23
Zwei Makros in ein Arbeitsblatt - zweite wird nicht ausführt
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1148to1152
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1148to1152
1148to1152
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Script steigt aus

Script steigt aus
Gegga
Hallo habe mit einer menge Hilfe folgendes zusammengebastelt, was bis vor 5 Min auch noch funktioniert hatte
Private Sub CB_ANLEGEN_Click()
'Startsheet immer eintragen
Sheets("Startsheet").Select
If WorksheetFunction.Subtotal(3, Range("D7:D65000")) = 1 Then
Dim lngRSTART As Long
Dim durchsuchen_START
bAction = False
With Sheets("Startsheet")
Set durchsuchen_START = .Range("D:D").Find(what:=TB_TEILENUMMER_KUNDE.Value, lookat:= _
xlWhole)
If Not durchsuchen_START Is Nothing Then
lngRSTART = durchsuchen_START.Row
.Cells(lngRSTART, 2) = TB_TEILEFAMILIE.Value
.Cells(lngRSTART, 3) = TB_PPSNUMMER.Value
.Cells(lngRSTART, 4) = TB_TEILENUMMER_KUNDE.Value
.Cells(lngRSTART, 5) = TB_BEZEICHNUNG.Value
.Cells(lngRSTART, 6) = CBO_KUNDE.Value
.Cells(lngRSTART, 7) = CBO_BRANCHE.Value
.Cells(lngRSTART, 8) = TB_ARTIKELCODE.Value / 100
'            .Cells(lngRSTART, 9) = TB_JAHRESTEILER.Value
.Cells(lngRSTART, 10) = TB_ANZAHL_RESTMONATE.Value
.Cells(lngRSTART, 12) = TB_PLANUNGSGRUNDLAGE.Value
.Cells(lngRSTART, 13) = TB_MIN.Value
.Cells(lngRSTART, 14) = TB_MAX.Value
.Cells(lngRSTART, 15) = TB_EINGABEDATUM_STÜCKZAHLEN.Value
.Cells(lngRSTART, 16) = TB_SICHERHEIT.Value
.Cells(lngRSTART, 18) = TB_AUFTEILUNGSFAKTOR_MASCHINE.Value
If IsNumeric(TB_AUFTEILUNG) Then
.Cells(lngRSTART, 20) = CDbl(TB_AUFTEILUNG.Value)
End If
.Cells(lngRSTART, 22) = TB_1_MACHINE.Value
If IsNumeric(TB_1_TE) Then
.Cells(lngRSTART, 23) = CDbl(TB_1_TE.Value)
End If
If IsNumeric(TB_1_TR_ATR) Then
.Cells(lngRSTART, 24) = CDbl(TB_1_TR_ATR.Value)
End If
.Cells(lngRSTART, 27) = TB_2_MACHINE.Value
If IsNumeric(TB_2_TE) Then
.Cells(lngRSTART, 28) = CDbl(TB_2_TE.Value)
End If
If IsNumeric(TB_2_TR_ATR) Then
.Cells(lngRSTART, 29) = CDbl(TB_2_TR_ATR.Value)
End If
.Cells(lngRSTART, 32) = TB_3_MACHINE.Value
If IsNumeric(TB_3_TE) Then
.Cells(lngRSTART, 33) = CDbl(TB_3_TE.Value)
End If
If IsNumeric(TB_3_TR_ATR) Then
.Cells(lngRSTART, 34) = CDbl(TB_3_TR_ATR.Value)
End If
.Cells(lngRSTART, 37) = TB_ZUSATZPROZESSE_ARBEITSPLATZ.Value
If IsNumeric(TB_ZUSATZPROZESSE_TE) Then
.Cells(lngRSTART, 38) = CDbl(TB_ZUSATZPROZESSE_TE.Value)
End If
If IsNumeric(TB_ZUSATZPROZESSE_TR_ATR) Then
.Cells(lngRSTART, 39) = CDbl(TB_ZUSATZPROZESSE_TR_ATR.Value)
End If
.Cells(lngRSTART, 47) = TB_MONAT01.Value
If IsNumeric(TB_PREIS01) Then
.Cells(lngRSTART, 48) = CDbl(TB_PREIS01.Value)
End If
.Cells(lngRSTART, 50) = TB_MONAT02.Value
If IsNumeric(TB_PREIS02) Then
.Cells(lngRSTART, 51) = CDbl(TB_PREIS02.Value)
End If
.Cells(lngRSTART, 53) = TB_MONAT03.Value
If IsNumeric(TB_PREIS03) Then
.Cells(lngRSTART, 54) = CDbl(TB_PREIS03.Value)
End If
.Cells(lngRSTART, 56) = TB_MONAT04.Value
If IsNumeric(TB_PREIS04) Then
.Cells(lngRSTART, 57) = CDbl(TB_PREIS04.Value)
End If
.Cells(lngRSTART, 59) = TB_MONAT05.Value
If IsNumeric(TB_PREIS05) Then
.Cells(lngRSTART, 60) = CDbl(TB_PREIS05.Value)
End If
.Cells(lngRSTART, 62) = TB_MONAT06.Value
If IsNumeric(TB_PREIS06) Then
.Cells(lngRSTART, 63) = CDbl(TB_PREIS06.Value)
End If
.Cells(lngRSTART, 65) = TB_MONAT07.Value
If IsNumeric(TB_PREIS07) Then
.Cells(lngRSTART, 66) = CDbl(TB_PREIS07.Value)
End If
.Cells(lngRSTART, 68) = TB_MONAT08.Value
If IsNumeric(TB_PREIS08) Then
.Cells(lngRSTART, 69) = CDbl(TB_PREIS08.Value)
End If
.Cells(lngRSTART, 71) = TB_MONAT09.Value
If IsNumeric(TB_PREIS09) Then
.Cells(lngRSTART, 72) = CDbl(TB_PREIS09.Value)
End If
.Cells(lngRSTART, 74) = TB_MONAT10.Value
If IsNumeric(TB_PREIS10) Then
.Cells(lngRSTART, 75) = CDbl(TB_PREIS10.Value)
End If
.Cells(lngRSTART, 77) = TB_MONAT11.Value
If IsNumeric(TB_PREIS11) Then
.Cells(lngRSTART, 78) = CDbl(TB_PREIS11.Value)
End If
.Cells(lngRSTART, 80) = TB_MONAT12.Value
If IsNumeric(TB_PREIS12) Then
.Cells(lngRSTART, 81) = CDbl(TB_PREIS12.Value)
End If
If IsNumeric(TB_ROHMATERIALPREIS) Then
.Cells(lngRSTART, 84) = CDbl(TB_ROHMATERIALPREIS.Value)
End If
.Cells(lngRSTART, 85) = TB_ROHMATERIALPREIS_DATUM.Value
.Cells(lngRSTART, 87) = TB_AFTG_AG_01.Value
.Cells(lngRSTART, 88) = TB_AFTG_AG_01_DATUM.Value
.Cells(lngRSTART, 90) = TB_AFTG_AG_02.Value
.Cells(lngRSTART, 91) = TB_AFTG_AG_02_DATUM.Value
.Cells(lngRSTART, 93) = TB_AFTG_AG_03.Value
.Cells(lngRSTART, 94) = TB_AFTG_AG_03_DATUM.Value
If IsNumeric(TB_VERKAUFSPREIS) Then
.Cells(lngRSTART, 96) = CDbl(TB_VERKAUFSPREIS.Value)
End If
.Cells(lngRSTART, 97) = TB_VERKAUSPREIS_DATUM.Value
If UF_SAETZE_BEARBEITEN.OP_WZ_EINGES_JA.Value = True Then
Sheets("Startsheet").Cells(lngRSTART, 45) = "X"
End If
If UF_SAETZE_BEARBEITEN.OP_WZ_MASCH_JA.Value = True Then
Sheets("Startsheet").Cells(lngRSTART, 46) = "X"
End If
End If
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! _
'Teile 1 abfragen
Sheets("Teile 1").Select
If WorksheetFunction.Subtotal(3, Range("D7:D65000")) = 1 Then
Dim lngRTEILE As Long
Dim durchsuchen
bAction = False
With Sheets("Teile 1")
Set durchsuchen = .Range("D:D").Find(what:=TB_TEILENUMMER_KUNDE.Value, lookat:=xlWhole)
If Not durchsuchen Is Nothing Then
lngRTEILE = durchsuchen.Row
.Cells(lngRTEILE, 2) = TB_TEILEFAMILIE.Value
.Cells(lngRTEILE, 3) = TB_PPSNUMMER.Value
.Cells(lngRTEILE, 4) = TB_TEILENUMMER_KUNDE.Value
.Cells(lngRTEILE, 5) = TB_BEZEICHNUNG.Value
.Cells(lngRTEILE, 6) = CBO_KUNDE.Value
.Cells(lngRTEILE, 7) = CBO_BRANCHE.Value
.Cells(lngRTEILE, 8) = TB_ARTIKELCODE.Value / 100
'            .Cells(lngRTEILE, 8) = TB_JAHRESTEILER.Value
.Cells(lngRTEILE, 9) = TB_ANZAHL_RESTMONATE.Value
.Cells(lngRTEILE, 11) = TB_PLANUNGSGRUNDLAGE.Value
.Cells(lngRTEILE, 12) = TB_MIN.Value
.Cells(lngRTEILE, 13) = TB_MAX.Value
.Cells(lngRTEILE, 14) = TB_EINGABEDATUM_STÜCKZAHLEN.Value
.Cells(lngRTEILE, 15) = TB_SICHERHEIT.Value
.Cells(lngRTEILE, 17) = TB_AUFTEILUNGSFAKTOR_MASCHINE.Value
If IsNumeric(TB_AUFTEILUNG) Then
.Cells(lngRTEILE, 19) = CDbl(TB_AUFTEILUNG.Value)
End If
.Cells(lngRTEILE, 21) = TB_1_MACHINE.Value
If IsNumeric(TB_1_TE.Value) Then
.Cells(lngRTEILE, 22) = CDbl(TB_1_TE.Value)
End If
If IsNumeric(TB_1_TR_ATR) Then
.Cells(lngRTEILE, 23) = CDbl(TB_1_TR_ATR.Value)
End If
.Cells(lngRTEILE, 26) = TB_2_MACHINE.Value
If IsNumeric(TB_2_TE) Then
.Cells(lngRTEILE, 27) = CDbl(TB_2_TE.Value)
End If
If IsNumeric(TB_2_TR_ATR) Then
.Cells(lngRTEILE, 28) = CDbl(TB_2_TR_ATR.Value)
End If
.Cells(lngRTEILE, 31) = TB_3_MACHINE.Value
If IsNumeric(TB_3_TE) Then
.Cells(lngRTEILE, 32) = CDbl(TB_3_TE.Value)
End If
If IsNumeric(TB_3_TR_ATR) Then
.Cells(lngRTEILE, 33) = CDbl(TB_3_TR_ATR.Value)
End If
.Cells(lngRTEILE, 36) = TB_ZUSATZPROZESSE_ARBEITSPLATZ.Value
If IsNumeric(TB_ZUSATZPROZESSE_TE) Then
.Cells(lngRTEILE, 37) = CDbl(TB_ZUSATZPROZESSE_TE.Value)
End If
If IsNumeric(TB_ZUSATZPROZESSE_TR_ATR) Then
.Cells(lngRTEILE, 38) = CDbl(TB_ZUSATZPROZESSE_TR_ATR.Value)
End If
If UF_SAETZE_BEARBEITEN.OP_WZ_EINGES_JA.Value = True Then
Sheets("Teile 1").Cells(lngRTEILE, 45) = "X"
If UF_SAETZE_BEARBEITEN.OP_WZ_MASCH_JA.Value = True Then
Sheets("Teile 1").Cells(lngRTEILE, 46) = "X"
Sheets("Umsatzplanung").Select
If WorksheetFunction.Subtotal(3, Range("C7:C65000")) = 1 Then
Dim lngRUMS As Long
Dim durchsuchen_UMS
bAction = False
With Sheets("Umsatzplanung")
Set durchsuchen_UMS = .Range("C:C").Find(what:=TB_TEILENUMMER_KUNDE.Value, lookat:=xlWhole)
If Not durchsuchen_UMS Is Nothing Then
lngRUMS = durchsuchen_UMS.Row
.Cells(lngRUMS, 2) = TB_PPSNUMMER.Value
.Cells(lngRUMS, 3) = TB_TEILENUMMER_KUNDE.Value
.Cells(lngRUMS, 4) = TB_BEZEICHNUNG.Value
.Cells(lngRUMS, 5) = CBO_KUNDE.Value
.Cells(lngRUMS, 6) = CBO_BRANCHE.Value
.Cells(lngRUMS, 8) = TB_ARTIKELCODE.Value / 100
'            .Cells(lngRUMS, 8) = TB_JAHRESTEILER.Value
.Cells(lngRUMS, 9) = TB_ANZAHL_RESTMONATE.Value
.Cells(lngRUMS, 11) = TB_PLANUNGSGRUNDLAGE.Value
.Cells(lngRUMS, 12) = TB_MIN.Value
.Cells(lngRUMS, 13) = TB_MAX.Value
.Cells(lngRUMS, 14) = TB_EINGABEDATUM_STÜCKZAHLEN.Value
.Cells(lngRUMS, 15) = TB_MONAT01.Value
If IsNumeric(TB_PREIS01) Then
.Cells(lngRUMS, 16) = CDbl(TB_PREIS01.Value)
End If
.Cells(lngRUMS, 18) = TB_MONAT02.Value
If IsNumeric(TB_PREIS02) Then
.Cells(lngRUMS, 19) = CDbl(TB_PREIS02.Value)
End If
.Cells(lngRUMS, 21) = TB_MONAT03.Value
If IsNumeric(TB_PREIS03) Then
.Cells(lngRUMS, 22) = CDbl(TB_PREIS03.Value)
End If
.Cells(lngRUMS, 24) = TB_MONAT04.Value
If IsNumeric(TB_PREIS04) Then
.Cells(lngRUMS, 25) = CDbl(TB_PREIS04.Value)
End If
End If
.Cells(lngRUMS, 27) = TB_MONAT05.Value
If IsNumeric(TB_PREIS05) Then
.Cells(lngRUMS, 28) = CDbl(TB_PREIS05.Value)
End If
.Cells(lngRUMS, 30) = TB_MONAT06.Value
If IsNumeric(TB_PREIS06) Then
.Cells(lngRUMS, 31) = CDbl(TB_PREIS06.Value)
End If
.Cells(lngRUMS, 33) = TB_MONAT07.Value
If IsNumeric(TB_PREIS07) Then
.Cells(lngRUMS, 34) = CDbl(TB_PREIS07.Value)
End If
.Cells(lngRUMS, 36) = TB_MONAT08.Value
If IsNumeric(TB_PREIS08) Then
.Cells(lngRUMS, 37) = CDbl(TB_PREIS08.Value)
End If
.Cells(lngRUMS, 39) = TB_MONAT09.Value
If IsNumeric(TB_PREIS09) Then
.Cells(lngRUMS, 40) = CDbl(TB_PREIS09.Value)
End If
.Cells(lngRUMS, 42) = TB_MONAT10.Value
If IsNumeric(TB_PREIS10) Then
.Cells(lngRUMS, 43) = CDbl(TB_PREIS10.Value)
End If
.Cells(lngRUMS, 45) = TB_MONAT11.Value
If IsNumeric(TB_PREIS11) Then
.Cells(lngRUMS, 46) = CDbl(TB_PREIS11.Value)
End If
.Cells(lngRUMS, 48) = TB_MONAT12.Value
If IsNumeric(TB_PREIS12) Then
.Cells(lngRUMS, 49) = CDbl(TB_PREIS12.Value)
End If
.Cells(lngRUMS, 51) = TB_SICHERHEIT.Value
.Cells(lngRUMS, 53) = TB_AUFTEILUNGSFAKTOR_MASCHINE.Value
.Cells(lngRUMS, 55) = TB_AUFTEILUNG.Value
If IsNumeric(TB_ROHMATERIALPREIS) Then
.Cells(lngRUMS, 58) = CDbl(TB_ROHMATERIALPREIS.Value)
End If
.Cells(lngRUMS, 59) = TB_ROHMATERIALPREIS_DATUM.Value
.Cells(lngRUMS, 61) = TB_AFTG_AG_01.Value
.Cells(lngRUMS, 62) = TB_AFTG_AG_01_DATUM.Value
.Cells(lngRUMS, 64) = TB_AFTG_AG_02.Value
.Cells(lngRUMS, 65) = TB_AFTG_AG_02_DATUM.Value
.Cells(lngRUMS, 67) = TB_AFTG_AG_03.Value
.Cells(lngRUMS, 68) = TB_AFTG_AG_03_DATUM.Value
If IsNumeric(TB_VERKAUFSPREIS) Then
.Cells(lngRUMS, 70) = CDbl(TB_VERKAUFSPREIS.Value)
End If
.Cells(lngRUMS, 71) = TB_VERKAUSPREIS_DATUM.Value
bAction = True
Set durchsuchen = Nothing
End With
End If
End If
End If
End If
End With
End If
End With
End If
Sheets("STARTSHEET").Select
Unload Me
End Sub

genau an der Stelle wo die vielen ausrufezeichen stehen steigt es plötzlich aus, keinen Schimmer warum...
Ich habe lediglich (auch hier erfragt, dieses miteingefügt, wo es für mich erforderlich war : If IsNumeric(TB_XXXX) Then ... End if
Wo liegt mein Fehler?
Grüße Gegga

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Script steigt aus
29.03.2010 09:43:56
xr8k2
Hallo Gegga,
was heißst denn "steigt aus" ... gibts einen Fehler, wenn ja was denn für einen?
Gruß,
xr8k2
AW: Script steigt aus
29.03.2010 09:49:34
Gegga
Hallo,
Mit aussteigen meinte ich das er die nachfolgenden Sätze nicht bearbeitet.
Grob erklart, Inhalte dieser UF müssen in 3 versch Sheets eingetragen werden, jenachdem ob die Teilenummer gefunden wurde oder nicht (Set durchsuchen = .Range("D:D").Find(what:=TB_TEILENUMMER_KUNDE.Value, lookat:=xlWhole))
Ich habe mir eine Teile nummer gesucht, die sicher auf allen drei Tabellenbättern vorhanden ist, und trotzdem hört mein Scribt nach dem ersten Tabellenblatt auf.
Hilft das?
Greetz
Anzeige
AW: Script steigt aus
29.03.2010 10:10:10
xr8k2
Hallo Gegga,
naja ... hilft jetzt nicht wirklich weiter aber ich könnt mir vorstellen, dass in dem Script diese vielen End Ifs am Ende vielleicht nicht an der richtigen Stelle stehen. Kann aber auch sein die sich daraus ergebende Funktionsweise ist so gewollt ?!... weiß ich nicht.
Ich würde sagen in deinem Fall tritt diese Bedingung 
Sheets("Teile 1").Select
If WorksheetFunction.Subtotal(3, Range("D7:D65000")) = 1 Then

eben nicht ein und damit werden dann sämtliche nachfolgende Eintragungen nicht mehr gemacht.
Hast du mal den Code einzelschrittweise ausgeführt? Dann siehts du was ich meine.
Gruß,
xr8k2
Anzeige
AW: Script steigt aus
29.03.2010 10:20:39
Gegga
Hi
Ja ich denke ich habe meine fehler bei den If und With Blöcken keinen Plan aber wo genau weiss ich nicht... Das is ja mein Problem.
Ich habe es im Einzelschrittmodus laufen lassen, aj und es steigt genau an der Eingangs erwähnten Stelle aus.
Noch ein weiteres Prob is mir aufgefallen. Wenn ich die daten jetzt nur auf Sheet 1 und 3 stehen habe, trägt er bei sheet 3 auch nichts ein, weill er bei sheet 2 nix findet und die Sub beendet...
Noch jemand nen Rat oder Hilfe?
Grüß
AW: Script steigt aus
29.03.2010 10:43:49
xr8k2
Hallo Gegga,
nach näherer betrachtung stehen die End Ifs und End Withs wirklich an den unmöglichsten Stellen.
Ich rate mal ... so könnte es aus meiner Sicht vielleicht Sinn machen ...
Private Sub CB_ANLEGEN_Click()
'Startsheet immer eintragen
With Sheets("Startsheet")
If WorksheetFunction.Subtotal(3, .Range("D7:D65000")) = 1 Then
Dim lngRSTART As Long
Dim durchsuchen_START
bAction = False
Set durchsuchen_START = .Range("D:D").Find(what:=TB_TEILENUMMER_KUNDE.Value, lookat:= _
xlWhole)
If Not durchsuchen_START Is Nothing Then
lngRSTART = durchsuchen_START.Row
.Cells(lngRSTART, 2) = TB_TEILEFAMILIE.Value
.Cells(lngRSTART, 3) = TB_PPSNUMMER.Value
.Cells(lngRSTART, 4) = TB_TEILENUMMER_KUNDE.Value
.Cells(lngRSTART, 5) = TB_BEZEICHNUNG.Value
.Cells(lngRSTART, 6) = CBO_KUNDE.Value
.Cells(lngRSTART, 7) = CBO_BRANCHE.Value
.Cells(lngRSTART, 8) = TB_ARTIKELCODE.Value / 100
'            .Cells(lngRSTART, 9) = TB_JAHRESTEILER.Value
.Cells(lngRSTART, 10) = TB_ANZAHL_RESTMONATE.Value
.Cells(lngRSTART, 12) = TB_PLANUNGSGRUNDLAGE.Value
.Cells(lngRSTART, 13) = TB_MIN.Value
.Cells(lngRSTART, 14) = TB_MAX.Value
.Cells(lngRSTART, 15) = TB_EINGABEDATUM_STÜCKZAHLEN.Value
.Cells(lngRSTART, 16) = TB_SICHERHEIT.Value
.Cells(lngRSTART, 18) = TB_AUFTEILUNGSFAKTOR_MASCHINE.Value
If IsNumeric(TB_AUFTEILUNG) Then
.Cells(lngRSTART, 20) = CDbl(TB_AUFTEILUNG.Value)
End If
.Cells(lngRSTART, 22) = TB_1_MACHINE.Value
If IsNumeric(TB_1_TE) Then
.Cells(lngRSTART, 23) = CDbl(TB_1_TE.Value)
End If
If IsNumeric(TB_1_TR_ATR) Then
.Cells(lngRSTART, 24) = CDbl(TB_1_TR_ATR.Value)
End If
.Cells(lngRSTART, 27) = TB_2_MACHINE.Value
If IsNumeric(TB_2_TE) Then
.Cells(lngRSTART, 28) = CDbl(TB_2_TE.Value)
End If
If IsNumeric(TB_2_TR_ATR) Then
.Cells(lngRSTART, 29) = CDbl(TB_2_TR_ATR.Value)
End If
.Cells(lngRSTART, 32) = TB_3_MACHINE.Value
If IsNumeric(TB_3_TE) Then
.Cells(lngRSTART, 33) = CDbl(TB_3_TE.Value)
End If
If IsNumeric(TB_3_TR_ATR) Then
.Cells(lngRSTART, 34) = CDbl(TB_3_TR_ATR.Value)
End If
.Cells(lngRSTART, 37) = TB_ZUSATZPROZESSE_ARBEITSPLATZ.Value
If IsNumeric(TB_ZUSATZPROZESSE_TE) Then
.Cells(lngRSTART, 38) = CDbl(TB_ZUSATZPROZESSE_TE.Value)
End If
If IsNumeric(TB_ZUSATZPROZESSE_TR_ATR) Then
.Cells(lngRSTART, 39) = CDbl(TB_ZUSATZPROZESSE_TR_ATR.Value)
End If
.Cells(lngRSTART, 47) = TB_MONAT01.Value
If IsNumeric(TB_PREIS01) Then
.Cells(lngRSTART, 48) = CDbl(TB_PREIS01.Value)
End If
.Cells(lngRSTART, 50) = TB_MONAT02.Value
If IsNumeric(TB_PREIS02) Then
.Cells(lngRSTART, 51) = CDbl(TB_PREIS02.Value)
End If
.Cells(lngRSTART, 53) = TB_MONAT03.Value
If IsNumeric(TB_PREIS03) Then
.Cells(lngRSTART, 54) = CDbl(TB_PREIS03.Value)
End If
.Cells(lngRSTART, 56) = TB_MONAT04.Value
If IsNumeric(TB_PREIS04) Then
.Cells(lngRSTART, 57) = CDbl(TB_PREIS04.Value)
End If
.Cells(lngRSTART, 59) = TB_MONAT05.Value
If IsNumeric(TB_PREIS05) Then
.Cells(lngRSTART, 60) = CDbl(TB_PREIS05.Value)
End If
.Cells(lngRSTART, 62) = TB_MONAT06.Value
If IsNumeric(TB_PREIS06) Then
.Cells(lngRSTART, 63) = CDbl(TB_PREIS06.Value)
End If
.Cells(lngRSTART, 65) = TB_MONAT07.Value
If IsNumeric(TB_PREIS07) Then
.Cells(lngRSTART, 66) = CDbl(TB_PREIS07.Value)
End If
.Cells(lngRSTART, 68) = TB_MONAT08.Value
If IsNumeric(TB_PREIS08) Then
.Cells(lngRSTART, 69) = CDbl(TB_PREIS08.Value)
End If
.Cells(lngRSTART, 71) = TB_MONAT09.Value
If IsNumeric(TB_PREIS09) Then
.Cells(lngRSTART, 72) = CDbl(TB_PREIS09.Value)
End If
.Cells(lngRSTART, 74) = TB_MONAT10.Value
If IsNumeric(TB_PREIS10) Then
.Cells(lngRSTART, 75) = CDbl(TB_PREIS10.Value)
End If
.Cells(lngRSTART, 77) = TB_MONAT11.Value
If IsNumeric(TB_PREIS11) Then
.Cells(lngRSTART, 78) = CDbl(TB_PREIS11.Value)
End If
.Cells(lngRSTART, 80) = TB_MONAT12.Value
If IsNumeric(TB_PREIS12) Then
.Cells(lngRSTART, 81) = CDbl(TB_PREIS12.Value)
End If
If IsNumeric(TB_ROHMATERIALPREIS) Then
.Cells(lngRSTART, 84) = CDbl(TB_ROHMATERIALPREIS.Value)
End If
.Cells(lngRSTART, 85) = TB_ROHMATERIALPREIS_DATUM.Value
.Cells(lngRSTART, 87) = TB_AFTG_AG_01.Value
.Cells(lngRSTART, 88) = TB_AFTG_AG_01_DATUM.Value
.Cells(lngRSTART, 90) = TB_AFTG_AG_02.Value
.Cells(lngRSTART, 91) = TB_AFTG_AG_02_DATUM.Value
.Cells(lngRSTART, 93) = TB_AFTG_AG_03.Value
.Cells(lngRSTART, 94) = TB_AFTG_AG_03_DATUM.Value
If IsNumeric(TB_VERKAUFSPREIS) Then
.Cells(lngRSTART, 96) = CDbl(TB_VERKAUFSPREIS.Value)
End If
.Cells(lngRSTART, 97) = TB_VERKAUSPREIS_DATUM.Value
If UF_SAETZE_BEARBEITEN.OP_WZ_EINGES_JA.Value = True Then
Sheets("Startsheet").Cells(lngRSTART, 45) = "X"
End If
If UF_SAETZE_BEARBEITEN.OP_WZ_MASCH_JA.Value = True Then
Sheets("Startsheet").Cells(lngRSTART, 46) = "X"
End If
End If
End If
End With
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! _
! _
'Teile 1 abfragen
With Sheets("Teile 1").Select
If WorksheetFunction.Subtotal(3, .Range("D7:D65000")) = 1 Then
Dim lngRTEILE As Long
Dim durchsuchen
bAction = False
Set durchsuchen = .Range("D:D").Find(what:=TB_TEILENUMMER_KUNDE.Value, lookat:=xlWhole)
If Not durchsuchen Is Nothing Then
lngRTEILE = durchsuchen.Row
.Cells(lngRTEILE, 2) = TB_TEILEFAMILIE.Value
.Cells(lngRTEILE, 3) = TB_PPSNUMMER.Value
.Cells(lngRTEILE, 4) = TB_TEILENUMMER_KUNDE.Value
.Cells(lngRTEILE, 5) = TB_BEZEICHNUNG.Value
.Cells(lngRTEILE, 6) = CBO_KUNDE.Value
.Cells(lngRTEILE, 7) = CBO_BRANCHE.Value
.Cells(lngRTEILE, 8) = TB_ARTIKELCODE.Value / 100
'            .Cells(lngRTEILE, 8) = TB_JAHRESTEILER.Value
.Cells(lngRTEILE, 9) = TB_ANZAHL_RESTMONATE.Value
.Cells(lngRTEILE, 11) = TB_PLANUNGSGRUNDLAGE.Value
.Cells(lngRTEILE, 12) = TB_MIN.Value
.Cells(lngRTEILE, 13) = TB_MAX.Value
.Cells(lngRTEILE, 14) = TB_EINGABEDATUM_STÜCKZAHLEN.Value
.Cells(lngRTEILE, 15) = TB_SICHERHEIT.Value
.Cells(lngRTEILE, 17) = TB_AUFTEILUNGSFAKTOR_MASCHINE.Value
If IsNumeric(TB_AUFTEILUNG) Then
.Cells(lngRTEILE, 19) = CDbl(TB_AUFTEILUNG.Value)
End If
.Cells(lngRTEILE, 21) = TB_1_MACHINE.Value
If IsNumeric(TB_1_TE.Value) Then
.Cells(lngRTEILE, 22) = CDbl(TB_1_TE.Value)
End If
If IsNumeric(TB_1_TR_ATR) Then
.Cells(lngRTEILE, 23) = CDbl(TB_1_TR_ATR.Value)
End If
.Cells(lngRTEILE, 26) = TB_2_MACHINE.Value
If IsNumeric(TB_2_TE) Then
.Cells(lngRTEILE, 27) = CDbl(TB_2_TE.Value)
End If
If IsNumeric(TB_2_TR_ATR) Then
.Cells(lngRTEILE, 28) = CDbl(TB_2_TR_ATR.Value)
End If
.Cells(lngRTEILE, 31) = TB_3_MACHINE.Value
If IsNumeric(TB_3_TE) Then
.Cells(lngRTEILE, 32) = CDbl(TB_3_TE.Value)
End If
If IsNumeric(TB_3_TR_ATR) Then
.Cells(lngRTEILE, 33) = CDbl(TB_3_TR_ATR.Value)
End If
.Cells(lngRTEILE, 36) = TB_ZUSATZPROZESSE_ARBEITSPLATZ.Value
If IsNumeric(TB_ZUSATZPROZESSE_TE) Then
.Cells(lngRTEILE, 37) = CDbl(TB_ZUSATZPROZESSE_TE.Value)
End If
If IsNumeric(TB_ZUSATZPROZESSE_TR_ATR) Then
.Cells(lngRTEILE, 38) = CDbl(TB_ZUSATZPROZESSE_TR_ATR.Value)
End If
If UF_SAETZE_BEARBEITEN.OP_WZ_EINGES_JA.Value = True Then
Sheets("Teile 1").Cells(lngRTEILE, 45) = "X"
End If
If UF_SAETZE_BEARBEITEN.OP_WZ_MASCH_JA.Value = True Then
Sheets("Teile 1").Cells(lngRTEILE, 46) = "X"
End If
End If
End If
End With
With Sheets("Umsatzplanung")
If WorksheetFunction.Subtotal(3, .Range("C7:C65000")) = 1 Then
Dim lngRUMS As Long
Dim durchsuchen_UMS
bAction = False
Set durchsuchen_UMS = .Range("C:C").Find(what:=TB_TEILENUMMER_KUNDE.Value, lookat:=xlWhole)
If Not durchsuchen_UMS Is Nothing Then
lngRUMS = durchsuchen_UMS.Row
.Cells(lngRUMS, 2) = TB_PPSNUMMER.Value
.Cells(lngRUMS, 3) = TB_TEILENUMMER_KUNDE.Value
.Cells(lngRUMS, 4) = TB_BEZEICHNUNG.Value
.Cells(lngRUMS, 5) = CBO_KUNDE.Value
.Cells(lngRUMS, 6) = CBO_BRANCHE.Value
.Cells(lngRUMS, 8) = TB_ARTIKELCODE.Value / 100
'            .Cells(lngRUMS, 8) = TB_JAHRESTEILER.Value
.Cells(lngRUMS, 9) = TB_ANZAHL_RESTMONATE.Value
.Cells(lngRUMS, 11) = TB_PLANUNGSGRUNDLAGE.Value
.Cells(lngRUMS, 12) = TB_MIN.Value
.Cells(lngRUMS, 13) = TB_MAX.Value
.Cells(lngRUMS, 14) = TB_EINGABEDATUM_STÜCKZAHLEN.Value
.Cells(lngRUMS, 15) = TB_MONAT01.Value
If IsNumeric(TB_PREIS01) Then
.Cells(lngRUMS, 16) = CDbl(TB_PREIS01.Value)
End If
.Cells(lngRUMS, 18) = TB_MONAT02.Value
If IsNumeric(TB_PREIS02) Then
.Cells(lngRUMS, 19) = CDbl(TB_PREIS02.Value)
End If
.Cells(lngRUMS, 21) = TB_MONAT03.Value
If IsNumeric(TB_PREIS03) Then
.Cells(lngRUMS, 22) = CDbl(TB_PREIS03.Value)
End If
.Cells(lngRUMS, 24) = TB_MONAT04.Value
If IsNumeric(TB_PREIS04) Then
.Cells(lngRUMS, 25) = CDbl(TB_PREIS04.Value)
End If
.Cells(lngRUMS, 27) = TB_MONAT05.Value
If IsNumeric(TB_PREIS05) Then
.Cells(lngRUMS, 28) = CDbl(TB_PREIS05.Value)
End If
.Cells(lngRUMS, 30) = TB_MONAT06.Value
If IsNumeric(TB_PREIS06) Then
.Cells(lngRUMS, 31) = CDbl(TB_PREIS06.Value)
End If
.Cells(lngRUMS, 33) = TB_MONAT07.Value
If IsNumeric(TB_PREIS07) Then
.Cells(lngRUMS, 34) = CDbl(TB_PREIS07.Value)
End If
.Cells(lngRUMS, 36) = TB_MONAT08.Value
If IsNumeric(TB_PREIS08) Then
.Cells(lngRUMS, 37) = CDbl(TB_PREIS08.Value)
End If
.Cells(lngRUMS, 39) = TB_MONAT09.Value
If IsNumeric(TB_PREIS09) Then
.Cells(lngRUMS, 40) = CDbl(TB_PREIS09.Value)
End If
.Cells(lngRUMS, 42) = TB_MONAT10.Value
If IsNumeric(TB_PREIS10) Then
.Cells(lngRUMS, 43) = CDbl(TB_PREIS10.Value)
End If
.Cells(lngRUMS, 45) = TB_MONAT11.Value
If IsNumeric(TB_PREIS11) Then
.Cells(lngRUMS, 46) = CDbl(TB_PREIS11.Value)
End If
.Cells(lngRUMS, 48) = TB_MONAT12.Value
If IsNumeric(TB_PREIS12) Then
.Cells(lngRUMS, 49) = CDbl(TB_PREIS12.Value)
End If
.Cells(lngRUMS, 51) = TB_SICHERHEIT.Value
.Cells(lngRUMS, 53) = TB_AUFTEILUNGSFAKTOR_MASCHINE.Value
.Cells(lngRUMS, 55) = TB_AUFTEILUNG.Value
If IsNumeric(TB_ROHMATERIALPREIS) Then
.Cells(lngRUMS, 58) = CDbl(TB_ROHMATERIALPREIS.Value)
End If
.Cells(lngRUMS, 59) = TB_ROHMATERIALPREIS_DATUM.Value
.Cells(lngRUMS, 61) = TB_AFTG_AG_01.Value
.Cells(lngRUMS, 62) = TB_AFTG_AG_01_DATUM.Value
.Cells(lngRUMS, 64) = TB_AFTG_AG_02.Value
.Cells(lngRUMS, 65) = TB_AFTG_AG_02_DATUM.Value
.Cells(lngRUMS, 67) = TB_AFTG_AG_03.Value
.Cells(lngRUMS, 68) = TB_AFTG_AG_03_DATUM.Value
If IsNumeric(TB_VERKAUFSPREIS) Then
.Cells(lngRUMS, 70) = CDbl(TB_VERKAUFSPREIS.Value)
End If
.Cells(lngRUMS, 71) = TB_VERKAUSPREIS_DATUM.Value
End If
End If
End With
bAction = True
Set durchsuchen = Nothing
Unload Me
End Sub
Gruß,
xr8k2
PS. Wenns nicht funktioniert wirst du weitere Hilfe aber erst dann erfahren, wenn du mal die Mappe hier hochladen tust ;-)
Anzeige
AW: Script steigt aus
29.03.2010 10:57:12
Luschi
Hallo Gegga,
in dieser Vba-Zeile: If WorksheetFunction.Subtotal(3, Range("D7:D65000")) = 1 Then
bedeutet die 3 die Excelfunktion 'ANZAHL' bzw. 'COUNTA'.
Laut Excel-Vba-Hilfe werden damit alle Zellen gezählt, die einen Inhalt haben- egal welcher Datentyp es ist; und wenn es auch nur 1 Leerzeichen ist. Solltest Du solche Zellen in dem Bereich haben, wird die If-Bedingung natürlich nicht erfüllt.
Gruß von Luschi
aus klein-Paris
AW: Script steigt aus
29.03.2010 11:22:21
Gegga
Hallo Luschi...
Was mich jetzt etwas stuzig macht ist die Tatsache, das es seither funktioniert hat. Oder "lese" ich diese Zeile falsch? Zumal ich da nix geändert habe.
Gesetzter Autofilter - dann,
If (Bedingung ("prüfen" ob in D7:d65000 ein Zeichen steht) Wenn Ja, mache weiter, Wenn nein, höre auf.
So sinngemäß also...
Ich vermute eher das ich irgendwie mit den Ifblöcken Schliessen bzw. With Blöcken den Hund drin habe...
Anzeige
AW: Script steigt aus
29.03.2010 12:40:46
fcs
Hallo Gegga,
hab mir deine Prozedur auch mal angesehen und kann xr8k2 nur bestätigen.
einige "EndIf" und auch die EndWith stehen an etwas willkürlicher Stelle.
Du hast die Abarbeitung der Blätter in einander geschachtelt. Damit endet die Ausführung wenn in einem der Blätter die Zählbedingung nicht erfüllt ist.
Ich hab die Logik mal so umgestrickt, dass die 3 Blätter unabhängig von einander abgearbeitet werden.
https://www.herber.de/bbs/user/68860.txt
Generell ist es immer hilfreich, die Zeilen zwischen With ... End With, If ... End If, und innerhalb von Schleifen einzurücken. Das erleichtert das Lesen des Codes und unterstützt ggf. die Fehlersuche.
Gruß
Franz
Anzeige
DANKE!!!!
29.03.2010 12:54:42
Gegga
Vielen Dank Franz für die Mühe!!!
Auch für die Kommentare, so sehe ich zumindest wo ich Mist gemacht habe. Und ja geb dir recht, es "liest" sich def. leichter.
Schönen Tag noch!!!
Gruß Gegga

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige