Office: Makro Zeitproblem! (Debug Modus funktioniert es, sonst nicht)

Lehtis · 20. Juli 2013

Ich hab ein Makro das nur richtig funktioniert, wenn ich es debuge.

Code:

Sub stueckliste_add()
Dim strDatei, wks As Worksheet
Dim Sheet As Worksheet
Set Sheet = ActiveSheet
strDatei = Application.GetOpenFilename

If strDatei False Then
Set wks = Workbooks.Open(strDatei).Sheets(1)
Else
Exit Sub
End If

Dim zeile As Integer
Dim zeile2 As Integer
Dim i As Integer

For i = 11 To 1000 '--->sucht die freie Position wo man weiter schreiben kann.
If (Len(Trim(Sheet.Cells(i, 6).Value)) = 0) Then
zeile2 = i
Exit For
End If
Next i

If (zeile2 11) Then '--->Falls es nicht die 11. Zeile ist dann soll es einen Abstand haben
zeile2 = zeile2 + 1
End If

For zeile = 10 To 1000 '--->Schreibt alle Zeilen in dieses Excel
If (Sheet.Cells(zeile2 + 1, 1).Value = "Ausgestellt") Then '--->Falls kein Platz mehr daraunter frei ist, dann soll eine neue Zeile eingefügt werden mit dem Format der drüberliegenden
Rows(zeile2).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C" & zeile2 & ":E" & zeile2).Select
Selection.Merge
End If
If (Len(Trim(wks.Cells(zeile, 2).Value)) 0) Then '--->Solange bis nichts mehr in der anderen Excel Datei steht
Sheet.Cells(zeile2, 6).Value = wks.Cells(zeile, 2).Value 'Zeichnungs Nr
Sheet.Cells(zeile2, 7).Value = wks.Cells(zeile, 3).Value 'Revision
Sheet.Cells(zeile2, 3).Value = wks.Cells(zeile, 4).Value 'Beschreibung
zeile2 = zeile2 + 1
Else
Exit For
End If
Next zeile

'hier dann die Daten kopieren
'und die Datei wieder schließen
wks.Parent.Close False
Set wks = Nothing
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Das Makro fügt aus einer anderen Excel Datei Zeilen ein, wenn es das Limit erreicht hat dann soll es eine neue Zeile einfügen. Genau da besteht das Problem. Wenn ich debugge dann fügt er brav eine Zeile ein, doch wenn ich es ganz normal ausführe dann macht er das nicht und schreibt die neuen Zeilen einfach weiter über anders drüber.

Wenn ich einen BREAK POINT setzte bei "Rows(zeile2).Select" also nach der IF da, dann geht es.

Es ist also ein Zeitproblem. Irgendwas macht da Probleme. Sieht einer zufällig raus was ich da anders machen sollte?

:)

DeBabba · 22. Juli 2013

Hi,
hatte auch mal so ein Problem(chen) und habe dann einfach ein
Application.Wait(Now + TimeValue("0:00:2"))
eingefügt. Also 2 Sekunden warten.
Wenn es wurscht ist ob das Makro 10 oder 20 sekunden läuft, hilft das

Gruß
DeBabba

Lehtis · 22. Juli 2013

Hilft komischerweise nicht. Hab da schon überall mal 2 sekunden warten lassen oder auch mehr, aber es hilft komischerweiße nichts.

DeBabba · 22. Juli 2013

Moin,
hmmm.... das ist aber wirklich nicht schön*frown.gif*
Das ist nur so ne Idee...
Wenn Du mal alle zellen die Du abfragst zuvor mal in ne variable reinschiebst und die dann abfragst und
Bau doch mal die Zeile um von
Range("C" & zeile2 & ":E" & zeile2).Select
selection.merge
nach
range(cells(zeile2,3),cells(zeile2,5)).merge

keine Ahnung ob das hilft,*confused.gif*
Gruß

Luschi · 22. Juli 2013

Hallo Lehtis,

es liegt sicher an der unzureichenden Referenzierung dieser Vba-Zeile:
Rows(zeile2).Select
Mit 'Debug.Print Rows(zeile2).Parent.Name' kann man überprüfen, in welcher Tabelle die entsprechende Zeile selektiert wird.
Und das ist sicher nicht die Tabelle, in der das geschehen soll.
Sheet.Rows(zeile2).Select
und
Sheet.Range("C" & zeile2 & ":E" & zeile2).Select
sollten das Problem beheben.

Gruß von Luschi
aus klein-Paris

PS: Die Variablenbezeichnung 'Sheet' halte ich für nicht so glücklich gewählt, da die Verwechslungsgefahr mit 'Sheets' doch sehr groß ist.
'Sht' wäre hier besser geeignet, noch besser 'wksh', da es ja eim Worksheet-Objekt ist.

Lehtis · 22. Juli 2013

Hi, danke, ich habs mal angepasst.

Code:

Sub stueckliste_add()
Dim strDatei, wks As Worksheet
Dim wksh As Worksheet
Set wksh = ActiveSheet
strDatei = Application.GetOpenFilename

If strDatei False Then
Set wks = Workbooks.Open(strDatei).Sheets(1)
Else
Exit Sub
End If

Dim zeile As Integer
Dim zeile2 As Integer
Dim i As Integer

For i = 11 To 1000 'sucht die freie Position wo man weiter schreiben kann.
If (Len(Trim(wksh.Cells(i, 6).Value)) = 0) Then
zeile2 = i
Exit For
End If
Next i

If (zeile2 11) Then 'Falls es nicht die 11. Zeile ist dann soll es einen Abstand haben
zeile2 = zeile2 + 1
End If

For zeile = 10 To 1000 'Schreibt alle Zeilen in dieses Excel
If (wksh.Cells(zeile2 + 1, 1).Value = "Ausgestellt") Then 'Falls kein Platz mehr daraunter frei ist, dann soll eine neue Zeile eingefügt werden mit dem Format der drüberliegenden
wksh.Rows(zeile2).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
wksh.Range(cells(zeile2,3),cells(zeile2,5)).merge
End If
If (Len(Trim(wks.Cells(zeile, 2).Value)) 0) Then 'Solange bis nichts mehr in der anderen Excel Datei steht
wksh.Cells(zeile2, 6).Value = wks.Cells(zeile, 2).Value 'Zeichnungs Nr
wksh.Cells(zeile2, 7).Value = wks.Cells(zeile, 3).Value 'Revision
wksh.Cells(zeile2, 3).Value = wks.Cells(zeile, 4).Value 'Beschreibung
zeile2 = zeile2 + 1
Else
Exit For
End If
Next zeile

'hier dann die Daten kopieren
'und die Datei wieder schließen
wks.Parent.Close False
Set wks = Nothing
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

wksh.Rows(zeile2).Select

Erzeugt ein Laufzeitfehler 1004

EarlFred · 22. Juli 2013

Hallo Name?,

[Edit]
zu langsam - vieles ist bereits gesagt worden - aber egal

wksh.Rows(zeile2).Select
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wenn ein Worksheet selbst nicht aktiv ist, kann man darauf auch nichts selecten.
[/Edit]

dann macht er das nicht und schreibt die neuen Zeilen einfach weiter über anders drüber.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

ich habe kein Bild davon, was Du mit diesem Satz meinst. Wo wird was wie eingefügt?

In der Zeile nach dem "IF da" fehlt zumindest schonmal die Angabe, welches Blatt gemeint ist, auf dem da etwas eingefügt werden soll. Zudem ist die Selecterei unnütz. Beides habe ich mal geändert.

Der Variablenname "Sheet" ist recht ungünstig.

Code:

Option Explicit

Sub stueckliste_add()
Dim strDatei, wks As Worksheet
Dim Sheet As Worksheet

Set Sheet = ActiveSheet
strDatei = Application.GetOpenFilename

If strDatei False Then
Set wks = Workbooks.Open(strDatei).Sheets(1)
Else
Exit Sub
End If

Dim zeile As Integer
Dim zeile2 As Integer
Dim i As Integer

zeile2 = Application.Max(Sheet.Cells(Rows.Count, 6).End(xlUp).Row, 10) + 1

For zeile = 10 To 1000 '--->Schreibt alle Zeilen in diese Exceldatei
If (Sheet.Cells(zeile2 + 1, 1).Value = "Ausgestellt") Then '--->Falls kein Platz mehr daraunter frei ist, dann soll eine neue Zeile eingefügt werden mit dem Format der drüberliegenden
Sheet.Rows(zeile2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheet.Range("C" & zeile2 & ":E" & zeile2).Merge
End If
If (Len(Trim(wks.Cells(zeile, 2).Value)) 0) Then '--->Solange bis nichts mehr in der anderen Excel Datei steht
Sheet.Cells(zeile2, 6).Value = wks.Cells(zeile, 2).Value 'Zeichnungs Nr
Sheet.Cells(zeile2, 7).Value = wks.Cells(zeile, 3).Value 'Revision
Sheet.Cells(zeile2, 3).Value = wks.Cells(zeile, 4).Value 'Beschreibung
zeile2 = zeile2 + 1
Else
Exit For
End If
Next zeile

'hier dann die Daten kopieren
'und die Datei wieder schließen
wks.Parent.Close False
Set wks = Nothing
Set Sheet = Nothing
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Von verbundenen Zellen halte ich nichts - wenn möglich, vermeide sie.

Grüße
EarlFred

Lehtis · 22. Juli 2013

Ok Danke an alle hier.
Nun funktioniert es *wink.gif*

Achja und danke für die Tipps ich werde versuchen alle zu befolgen.

Office: Makro Zeitproblem! (Debug Modus funktioniert es, sonst nicht)

Makro Zeitproblem! (Debug Modus funktioniert es, sonst nicht)

Makro Zeitproblem! (Debug Modus funktioniert es, sonst nicht)

Makro Zeitproblem! (Debug Modus funktioniert es, sonst nicht)

Makro Zeitproblem! (Debug Modus funktioniert es, sonst nicht)

Makro Zeitproblem! (Debug Modus funktioniert es, sonst nicht) - Similar Threads - Makro Zeitproblem Debug

Name der Datei durch Excel geändert

Ein Makro für mehrere Register

Makro öffnet unerwartete Datei

Leerzeilen entfernen

Makro Schaltflaechen vervielfaeltigen sich....

Seit Win 11 Zugriffsprobleme bei Excel über Makros

VBA-Makro zur Zellenformatierung Syntax probleme