Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1036to1040
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
Inhaltsverzeichnis

Makroablauf

Makroablauf
09.01.2009 16:15:00
sepp
Hallo
mein Makro läuft bei Verwendung von Einzelschritten (F8) im Editor sehr gut.
Aber beim Start durch eine Tastenkombination auf Excel bleibt das Programm
in der Mitte stehen. (Zuvor wurde eine Arbeitsmappe geöffnet. In diese sollten dann Daten geschrieben werden, was es aber nicht mehr macht)
Kann hier jemand Hilfe anbieten?
lg
sepp

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: welches Makro? welcher Fehler?
09.01.2009 16:22:00
Erich
Hallo Sepp,
da wir dein Makro nicht kennen, können wir auch nicht wissen, bei welcher Anweisung "in der Mitte"
VBA stehen bleibt.
Nützlich für eine Antwort wären:
1. dein Code
2. die Angabe der Zeile, in der VBA hängen bleibt
3. die Angabe einer Fehlernummer und eines Fehlertextes, soweit vorhanden
Evtl. ist auch eine kleine Beispielmappe sinnvoll.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
AW: welches Makro? welcher Fehler?
10.01.2009 08:28:30
sepp
Hallo Erich,
danke für Deine Hilfe
anbei das Makro:

Sub fertig()
Dim i, L, M As Long
Dim posLiWkb, stkList As Worksheet
Dim optName1, spName As String
Dim Mappe As Workbook
Dim z, testNam As Integer
Dim NamSuch As String
Dim lRowEnd
Application.ScreenUpdating = False
' speichern von optneu
ActiveWorkbook.Save
Windows("OPTNEU.XLS:2").Activate
Sheets("Opt").Select
'   löschen der Zeilen mit Leer oder Nullwerten
Set posLiWkb = ActiveWorkbook.Worksheets("OPT")
posLiWkb.Activate
For M = 2 To posLiWkb.UsedRange.Rows.Count
If posLiWkb.Cells(M, 1) = "" Then
posLiWkb.Rows(M).Delete Shift:=xlUp
End If
Next M
With ActiveSheet
lRowEnd = .UsedRange.Rows.Count
End With
' formatieren von C, D (Länge Breite)
Columns("C:D").Select
Selection.NumberFormat = "0"
Range("B1").Select
optName1 = Mid(Range("A2"), 2, 3)
spName = "opt" & optName1 & "-" & Date & "-" & Hour(Time) & "h" & Minute(Time)
ActiveWorkbook.SaveCopyAs "z:\dekore\stkListSich\" & (spName)
'check ob stkList geöffnet ist
z = 1: testNam = 0
For Each Mappe In Workbooks
NamSuch = Mappe.Name
z = z + 1
If NamSuch = "stkList.xls" Then
testNam = 1
GoTo namOK
End If
Next Mappe
namOK:
If testNam = 0 Then
Workbooks.Open "c:\Optimierung\stkList.xls"            '   !!!!!! an dieser Stelle stoppt das  _
Programm !!!!!
End If
Windows("stkList.xls").Activate
Set stkList = Workbooks("stkList.xls").Sheets("stk")
stkList.Activate
i = 2
For L = 2 To posLiWkb.UsedRange.Rows.Count
'Eintrag
Do Until stkList.Cells(i, 1) = ""
i = i + 1
Loop
stkList.Cells(i, 1).Value = posLiWkb.Cells(L, 1)
stkList.Cells(i, 2).Value = posLiWkb.Cells(L, 2)
stkList.Cells(i, 3).Value = posLiWkb.Cells(L, 3)
stkList.Cells(i, 4).Value = posLiWkb.Cells(L, 4)
stkList.Cells(i, 5).Value = posLiWkb.Cells(L, 5)
stkList.Cells(i, 6).Value = posLiWkb.Cells(L, 6)
stkList.Cells(i, 7).Value = posLiWkb.Cells(L, 7)
stkList.Cells(i, 8).Value = posLiWkb.Cells(L, 8)
stkList.Cells(i, 9).Value = posLiWkb.Cells(L, 9)
stkList.Cells(i, 10).Value = posLiWkb.Cells(L, 10)
Next L
posLiWkb.Activate
With ActiveSheet
lRowEnd = .UsedRange.Rows.Count
End With
posLiWkb.Rows("2:10000").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Windows("optVorl").Activate
Windows("OPTNEU.XLS:2").Activate
Sheets("zu").Select
Application.ScreenUpdating = True
End Sub


Die Datei stkList wird nicht mehr aktiviert für die Dateneingabe.
lg sepp

Anzeige
AW: welcher Fehler?
10.01.2009 10:21:00
Erich
Hallo Sepp,
die ersten beiden Punkte meiner Rückfrage hast du nun beantwortet.
Wie wäre es jetzt mit einer Antwort auf
"3. die Angabe einer Fehlernummer und eines Fehlertextes, soweit vorhanden" ?
Oder gibt es gar keine Fehlermeldung?
Noch eine Frage:
Ist c:\Optimierung\stkList.xls vielleicht vorher schon geöffnet?
Oder wird die Mappe in der markierten Anweisung geöffnet - und danach bleibt das Makro stehen?
Welchen Wert hat die Variable testNam nach dem Stop?
Und ein paar Bemerkungen zum Code:
Mit Dim i, L, M As Long wird nur M zu Long, i und L sind Variant.
Ja, man muss tatsächlich "Dim i As Long, L As Long, M As Long" schreiben!
Bei einer einzelnen Verwendung in
With ActiveSheet
lRowEnd = .UsedRange.Rows.Count
End With
lohnt sich der Einsatz der With-Klammer nun wirklich nicht, das geht so einfacher:
lRowEnd = ActiveSheet.UsedRange.Rows.Count
lRowEnd wird zweimal belegt, aber überhaupt nicht verwendet - kann also ersatzlos entfallen.
Das gilt auch für die Variable z - sie ist einfach überflüssig.
Mit

For M = 2 To posLiWkb.UsedRange.Rows.Count
If posLiWkb.Cells(M, 1) = "" Then
posLiWkb.Rows(M).Delete Shift:=xlUp
End If
Next M

wird NICHT jede leere Zelle gelöscht. Wenn A2 und A3 leer sind, wird bei M=2 die Zeile 2 gelöscht.
Die alte Zeile 3 ist nun Zeile 2. Im nächsten Schleifendurchlauf ist M=3. Die neue (leere) Zeile 2 wird nicht mehr gesehen.
Besser so:


For M = posLiWkb.UsedRange.Rows.Count To 2 Step -1
If posLiWkb.Cells(M, 1) = "" Then posLiWkb.Rows(M).Delete Shift:=xlUp
Next M

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Anzeige
AW: welcher Fehler?
12.01.2009 09:42:12
sepp
Hallo Erich,
danke für die Tipps
du hast Recht, es gibt keine Fehlermeldung
es arbeitet einfach nicht weiter
If testNam = 0 Then
Workbooks.Open "c:\Optimierung\stkList.xls" 'an dieser Stelle arbeitet das Programm nicht weiter
End If
es öffnet nur stkList.xls
bei einem Haltepunkt bei END IF und anschließendem Programmstart wird der Editor nicht wie sonst geöffnet dh. aus irgendeinem Grund macht das Makro nicht weiter
durch Einzelschritte im Editor arbeitet das Programm einwandfrei
deine Anregungen hab ich bereits durchgeführt
mit:
z = 1: testNam = 0
For Each Mappe In Workbooks
NamSuch = Mappe.Name
z = z + 1
If NamSuch = "stkList.xls" Then
testNam = 1
GoTo namOK
End If
Next Mappe
namOK:
If testNam = 0 Then
Workbooks.Open "c:\Optimierung\stkList.xls" 'an dieser Stelle stoppt das Programm
End If
wird nachgesehen ob stkList bereits geöffnet ist, sonst öffnen für den Dateneintrag
lg sepp
Anzeige
AW: Test mit anderer Mappe?
12.01.2009 10:40:20
Erich
Hallo Sepp,
könnte es sein, dass es in c:\Optimierung\stkList.xls Makros gibt, die den Abbruch verursachen?
Hast du mal ausprobiert, ob das Makro nach dem Öffnen weiter läuft, wenn du eine (unverdächtige) andere Mappe öffnen lässt, also nicht die stkList.xls?
(Du kannst ja nach dem Öffnen eine MsgBox ausgeben lassen und danach mit "Stop" unterbrechen
oder mit "Exit Sub" beenden.)
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
AW: Test mit anderer Mappe?
12.01.2009 15:08:40
sepp
Hallo Erich,
du hast Recht - mit einer neutralen Datei funktioniert das Programm.
es funktioniert auch wenn stkList bereits geöffnet ist
In dere Datei stkList befinden sich Makros
kann es trotzdem funktionieren
Public m2, anzZu As Long
Public dek As String
Option Explicit

Sub raus()
Dim aktWkb, stkList, wkCSV, holzList As Worksheet
Dim d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11, d12, listBu, dek1, verglBu, spName As String
Dim n, i, L As Long
Dim spName1
Application.ScreenUpdating = False
spName1 = "stkListKopie" & Date & " Zeit " & Hour(Time) & "h" & Minute(Time) & "M" & Second( _
Time)
ActiveWorkbook.SaveCopyAs "z:\Dekore\stkListSich\" & (spName1)
Set stkList = Workbooks("stkList").Sheets("stk")
Set wkCSV = Workbooks("stkList").Sheets("csv")
dek1 = wkCSV.Range("A5")
listBu = UCase(wkCSV.Range("G6"))
spName = dek1 & "D" & Date & " Zeit " & Hour(Time) & "h" & Minute(Time)
d1 = -3: d2 = -4: d3 = -8: d4 = -16: d5 = -19: d6 = -28: d7 = -38: d8 = -56: d9 = -10: d10 = - _
12: d11 = -25: d12 = -32: anzZu = 0
Workbooks.Open "c:\Optimierung\csvListe.xls"
Workbooks("csvListe.xls").Activate
ActiveWorkbook.SaveAs Filename:="C:\Optimierung\optXLS\" & spName, _
CreateBackup:=False
Set aktWkb = ActiveWorkbook.Worksheets("Tabelle1")
For n = 0 To 11
wkCSV.Activate
Range("C5").Activate
d1 = ActiveCell.Offset(0, n)
dek = dek1 & "-" & d1: m2 = 0: anzZu = 0
stkList.Activate
For L = 2 To stkList.UsedRange.Rows.Count
If stkList.Cells(L, 7) Like dek Then
If listBu = "" Or Not Right(dek, 2) = "19" Then
i = 2
'Eintrag
Do Until aktWkb.Cells(i, 1) = ""
i = i + 1
Loop
aktWkb.Cells(i, 1).Value = stkList.Cells(L, 1)
aktWkb.Cells(i, 2).Value = stkList.Cells(L, 2)
aktWkb.Cells(i, 3).Value = Round(stkList.Cells(L, 3) + 0.001)
aktWkb.Cells(i, 4).Value = Round(stkList.Cells(L, 4) + 0.001)
aktWkb.Cells(i, 5).Value = stkList.Cells(L, 5)
aktWkb.Cells(i, 6).Value = stkList.Cells(L, 6)
aktWkb.Cells(i, 7).Value = stkList.Cells(L, 7)
aktWkb.Cells(i, 8).Value = stkList.Cells(L, 8)
aktWkb.Cells(i, 9).Value = stkList.Cells(L, 9)
aktWkb.Cells(i, 10).Value = stkList.Cells(L, 10)
'Stat
m2 = m2 + stkList.Cells(L, 2) * stkList.Cells(L, 3) / 1000 * stkList.Cells(L, 4) / 1000
anzZu = anzZu + stkList.Cells(L, 2)
stkList.Rows(L).Delete Shift:=xlUp
L = L - 1
Else
verglBu = ("*" & UCase(Left(stkList.Cells(L, 6), 1)) & "*")
If Right(dek, 2) = "19" Then
If listBu Like verglBu Then
i = 2
'Eintrag
Do Until aktWkb.Cells(i, 1) = ""
i = i + 1
Loop
aktWkb.Cells(i, 1).Value = stkList.Cells(L, 1)
aktWkb.Cells(i, 2).Value = stkList.Cells(L, 2)
aktWkb.Cells(i, 3).Value = Round(stkList.Cells(L, 3) + 0.001)
aktWkb.Cells(i, 4).Value = Round(stkList.Cells(L, 4) + 0.001)
aktWkb.Cells(i, 5).Value = stkList.Cells(L, 5)
aktWkb.Cells(i, 6).Value = stkList.Cells(L, 6)
aktWkb.Cells(i, 7).Value = stkList.Cells(L, 7)
aktWkb.Cells(i, 8).Value = stkList.Cells(L, 8)
aktWkb.Cells(i, 9).Value = stkList.Cells(L, 9)
aktWkb.Cells(i, 10).Value = stkList.Cells(L, 10)
'Stat
m2 = m2 + stkList.Cells(L, 2) * stkList.Cells(L, 3) / 1000 * stkList.Cells(L, 4) _
/ 1000
anzZu = anzZu + stkList.Cells(L, 2)
stkList.Rows(L).Delete Shift:=xlUp
L = L - 1
End If
End If
End If
End If
Next L
'eintrag für Statistik
If anzZu > 0 Then
mkStat
End If
Next n
'speichern unter xls und csv
aktWkb.Activate
'Holz- und Aluleisten rausschreiben
Set holzList = ActiveWorkbook.Worksheets("druck")
i = 1
For n = 2 To aktWkb.UsedRange.Rows.Count
If Left(aktWkb.Cells(n, 8), 1) = "L" Or Left(aktWkb.Cells(n, 8), 1) = "R" Or Left(aktWkb.Cells( _
n, 8), 1) = "M" Or Left(aktWkb.Cells(n, 8), 1) = "G" _
Or Left(aktWkb.Cells(n, 8), 1) = "S" Or Left(aktWkb.Cells(n, 8), 1) = "F" Or Left(aktWkb.Cells( _
n, 8), 1) = "D" Or Left(aktWkb.Cells(n, 8), 1) = "H" _
Or Left(aktWkb.Cells(n, 8), 1) = "I" Or Left(aktWkb.Cells(n, 8), 1) = "Z" Then
'Eintrag
Do Until holzList.Cells(i, 1) = ""
Loop
'  holzList.Cells(i, 1).Value = aktWkb.Cells(n, 1)
holzList.Cells(i, 2).Value = aktWkb.Cells(n, 2)
holzList.Cells(i, 3).Value = aktWkb.Cells(n, 3)
holzList.Cells(i, 4).Value = aktWkb.Cells(n, 4)
holzList.Cells(i, 5).Value = aktWkb.Cells(n, 5)
holzList.Cells(i, 6).Value = aktWkb.Cells(n, 6)
holzList.Cells(i, 7).Value = aktWkb.Cells(n, 7)
holzList.Cells(i, 8).Value = aktWkb.Cells(n, 8)
holzList.Cells(i, 9).Value = aktWkb.Cells(n, 9)
holzList.Cells(i, 10).Value = aktWkb.Cells(n, 10)
i = i + 1
End If
Next n
'druck der Leisten
If holzList.Range("B1") = "" Then
Else
holzList.Activate
Range(Cells(1, 1), Cells(n + 1, 11)).Select
Selection.Sort Key1:=Range("H1"), Order1:=xlAscending, Key2:=Range("C1") _
, Order2:=xlDescending, Key3:=Range("D1"), Order3:=xlDescending _
, Header:=xlNo, OrderCustom:=1 _
, MatchCase:=False, Orientation:=xlTopToBottom
ActiveWindow.SelectedSheets.PrintOut
End If
'sichern
aktWkb.Activate
'sichern einer Kopie auf dem Sever und anschl. csv Erstellung
ActiveWorkbook.Save
ActiveWorkbook.SaveCopyAs "z:\dekore\stkListSich\" & (spName)
ActiveWorkbook.SaveAs Filename:="C:\optstkl\" & spName, FileFormat _
:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close SaveChanges:=False
'uebersicht aktualisieren
wkCSV.Activate
check
ActiveWorkbook.Save
Application.ScreenUpdating = True
End Sub



Sub mkStat()
Dim stkList, wkStat, wkUeber As Worksheet
Dim dekVorh As Integer
Dim m2Alt, anzZuAlt, L, M As Long
Set stkList = Workbooks("stkList").Sheets("stk")
Set wkStat = Workbooks("stkList").Sheets("stat")
Set wkUeber = Workbooks("stkList").Sheets("ueber")
dekVorh = 0: m2Alt = 0: anzZuAlt = 0
For L = 2 To wkStat.UsedRange.Rows.Count
If wkStat.Cells(L, 1).Value = dek Then
m2Alt = wkStat.Cells(L, 5).Value: anzZuAlt = wkStat.Cells(L, 4).Value
wkStat.Cells(L, 1).Value = dek: wkStat.Cells(L, 5).Value = m2 * 1.1 + m2Alt: wkStat.Cells(L, 4). _
Value = anzZu + anzZuAlt
wkStat.Cells(L, 2).Value = Left(dek, 3): wkStat.Cells(L, 3).Value = Mid(dek, 5, 2): wkStat. _
Cells(L, 6).Value = (m2 * 1.1 + m2Alt) / 5.8
dekVorh = 1
End If
Next L
If dekVorh = 1 Then GoTo Sort
wkStat.Cells(L + 1, 1).Value = dek: wkStat.Cells(L + 1, 5).Value = m2 * 1.1: wkStat.Cells(L + 1, _
4).Value = anzZu
wkStat.Cells(L + 1, 2).Value = Left(dek, 3): wkStat.Cells(L + 1, 3).Value = Mid(dek, 5, 2):  _
wkStat.Cells(L + 1, 6).Value = m2 * 1.1 / 5.8
Sort:
wkStat.Activate
Columns("A:H").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1,  _
MatchCase:=False _
, Orientation:=xlTopToBottom
Range("A2").Select
'eintrag in uebersicht
M = wkUeber.UsedRange.Rows.Count
wkUeber.Cells(M + 1, 1).Value = dek: wkUeber.Cells(M + 1, 5).Value = m2 * 1.1: wkUeber.Cells(M + _
1, 4).Value = anzZu
wkUeber.Cells(M + 1, 2).Value = Left(dek, 3): wkUeber.Cells(M + 1, 3).Value = Mid(dek, 5, 2):  _
wkUeber.Cells(M + 1, 6).Value = m2 * 1.1 / 5.8
wkUeber.Cells(M + 1, 7).Value = Date
End Sub


Anzeige
AW: Open-Makro?
12.01.2009 16:58:00
Erich
Hallo Sepp,
wenn da irgendwelche Makros sin stkList.xls sind, sollte das überhaupt nicht stören - es sein denn,
da wird beim Öffnen automatisch etwas gestartet.
Gibt es in stkList.xls ein Workbook_Open (im Modul "DieseArbeitsmappe")?
Wenn ja: Soll das auch laufen, wenn die Mappe durch die Prozedur "fertig" geöffnet wird?
Der Code in deinem letzten Beitrag ist sicher nicht komplett. Da kommt "check" vor,
vermutlich ein Prozeduraufruf.
Dieser Hinweis blieb wohl noch ohne Folgen:

Und ein paar Bemerkungen zum Code:
Mit Dim i, L, M As Long wird nur M zu Long, i und L sind Variant.
Ja, man muss tatsächlich "Dim i As Long, L As Long, M As Long" schreiben!

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Anzeige
AW: welcher Fehler?
12.01.2009 19:57:00
sepp
Hallo Erich,
das Programm läuft jetzt und sieht dank deiner Hilfe jetzt so aus:
Option Explicit

Sub fertig()
Dim i As Long, L As Long, M As Long
Dim posLiWkb As Worksheet, posLiZu As Worksheet, stkList As Worksheet
Dim optName1 As String, spName As String
Dim Mappe As Workbook
Dim z As Integer, testNam As Integer
Dim NamSuch As String
Application.ScreenUpdating = False
' speichern von optneu
ActiveWorkbook.Save
Windows("OPTNEU.XLS:1").Activate
Sheets("Opt").Select
'   löschen der Zeilen mit Leer oder Nullwerten
Set posLiZu = ActiveWorkbook.Worksheets("Zu")
Set posLiWkb = ActiveWorkbook.Worksheets("OPT")
posLiWkb.Activate
For M = posLiWkb.UsedRange.Rows.Count To 2 Step -1
If posLiWkb.Cells(M, 1) = "" Then posLiWkb.Rows(M).Delete Shift:=xlUp
Next M
' formatieren von C, D (Länge Breite)
Columns("C:D").Select
Selection.NumberFormat = "0"
Range("B1").Select
optName1 = Mid(Range("A2"), 2, 3)
spName = "opt" & optName1 & "-" & Date & "-" & Hour(Time) & "h" & Minute(Time)
ActiveWorkbook.SaveCopyAs "z:\dekore\stkListSich\" & (spName)
'check ob stkList geöffnet ist
z = 1: testNam = 0
For Each Mappe In Workbooks
NamSuch = Mappe.Name
z = z + 1
If NamSuch = "stkList.xls" Then
testNam = 1
GoTo namOK
End If
Next Mappe
namOK:
If testNam = 0 Then
Workbooks.Open "c:\Optimierung\stkList.xls"
End If
Windows("stkList.xls").Activate
Set stkList = Workbooks("stkList.xls").Sheets("stk")
stkList.Activate
i = 2
For L = 2 To posLiWkb.UsedRange.Rows.Count
'Eintrag
Do Until stkList.Cells(i, 1) = ""
i = i + 1
Loop
stkList.Cells(i, 1).Value = posLiWkb.Cells(L, 1)
stkList.Cells(i, 2).Value = posLiWkb.Cells(L, 2)
stkList.Cells(i, 3).Value = posLiWkb.Cells(L, 3)
stkList.Cells(i, 4).Value = posLiWkb.Cells(L, 4)
stkList.Cells(i, 5).Value = posLiWkb.Cells(L, 5)
stkList.Cells(i, 6).Value = posLiWkb.Cells(L, 6)
stkList.Cells(i, 7).Value = posLiWkb.Cells(L, 7)
stkList.Cells(i, 8).Value = posLiWkb.Cells(L, 8)
stkList.Cells(i, 9).Value = posLiWkb.Cells(L, 9)
stkList.Cells(i, 10).Value = posLiWkb.Cells(L, 10)
Next L
ActiveWorkbook.Worksheets("csv").Activate
Workbooks("stkList").Save
posLiWkb.Activate
posLiWkb.Rows("2:10000").Select
Selection.Delete Shift:=xlUp
posLiZu.Activate
Range("A1").Select
ActiveWorkbook.Save
Application.ScreenUpdating = True
End Sub


Ein Programm welches beim Öffnen der Arbeitsmappe startet gibt es nicht.
Die Tastenkombination für den Programmstart habe ich zufällig geändert.
Wahrscheinlich gab es hier ein Problem.
Danke lg sepp

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige