Anzeige
Archiv - Navigation
1320to1324
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

Macroproblem unter 2013

Macroproblem unter 2013
14.07.2013 15:57:57
Benedikt
Guten Tag zusammen.
nachfolgendes Macro erledigt seinen Job unter 2007 und 2010 einwandfrei.
Jetzt habe ich 2013 aufgespielt und wie bei jedem Versionswechsel klemmt das eine oder andere. Das Macro fügt Text und Beträge aus einem Kalkulationsblatt (separate Datei)in das Offertblahtt ein.
Unter Office 2013 fügt das Macro beim ersten ausführen den Text nicht mehr in die vorgegebenen Zellen sondern überschreibt einen Teil der Adresse.Ab dem zweiten Textblock funktioniert es. Mit F8, schrittweise ausführen funktioniert es aber auch beim ersten mal. In der Annahme das die Geschwindigkeit unter 2013 das Problem sein könnte, habe ich versucht Application.Wait(Now + TimeValue("0:00:1"))einzubauen.
Aber entweder stelle ich mich wieder ganz clever an und habe es an der falschen Stelle eingesetzt, oder ich bin damit komplett auf dem Holzweg.
Ich bin sehr Dankbar wenn Ihr mir helfen könnt. Da es mehrere grosse Dateien sind ist ein Upload nicht möglich. Im Anhang aber eine Datei welche das Resultat zeigt.
https://www.herber.de/bbs/user/86347.xlsm
Vielen herzlichen Dank und einen schönen Sommertag. Grüsse Benedikt
Option Explicit
Const cstrRange As String = "C20:C2000"
Public rng As Range, lngRow As Long, Kalkblatt As Worksheet, neu As Long, Spalte As Long
Public NameMappe As String
Public NummerMappe As Variant
Function Freien_Platz_suchen()
With Workbooks("Tempoff.xlsm").Worksheets("Offerte")
For Each rng In .Range(cstrRange)
If rng = "" Then
If rng.Offset(1, 0) = "" And Not Intersect(rng.Offset(1, 0), .Range(cstrRange)) Is Nothing Then
If rng.Offset(2, 0) = "" And Not Intersect(rng.Offset(2, 0), .Range(cstrRange)) Is Nothing Then
lngRow = rng.Row + 1
Exit For
End If
End If
End If
Next
End With
End Function
Public Function MappeCopy()
NameMappe = Left(Range("C8").Value, 15)
NummerMappe = Workbooks("Tempoff.xlsm").Sheets.Count
NummerMappe = NummerMappe + 1
ActiveSheet.Copy After:=Workbooks("Tempoff.xlsm").Sheets(3)
ActiveSheet.Name = NummerMappe & " " & NameMappe
Sheets("Offerte").Select
End Function
Function Text_einfügen()
With Workbooks("Tempoff.xlsm").Worksheets("Offerte").Cells(lngRow, Spalte)
.PasteSpecial Paste:=xlValues
End With
Application.CutCopyMode = False
End Function Sub Test()
Freien_Platz_suchen
Application.ScreenUpdating = False
'Titel kopieren
lngRow = lngRow + 1
If lngRow > 0 Then Sheets("Hugo").Range("C8").Copy
Spalte = 3
Text_einfügen
'Nummerierung
Workbooks("Tempoff.xlsm").Worksheets("Offerte").Activate
ActiveCell.Offset(0, -1) = Int(Application.WorksheetFunction.Max(Range(Cells(1, 2), Cells(ActiveCell.Row, 2)))) + 1
Selection.Font.Bold = True
Workbooks("Tempkalk.xlsm").Worksheets("Hugo").Activate
'Text einfügen
Freien_Platz_suchen
lngRow = lngRow
If lngRow > 0 Then Sheets("Hugo").Range("C9:C21").Copy
Text_einfügen
'Totalkopieren
Freien_Platz_suchen
lngRow = rng.Row - 1
If lngRow > 0 Then Sheets("Hugo").Range("I8:K8").Copy
Spalte = 8
Text_einfügen
'Arbeitsblatt drucken
Workbooks("Tempkalk.xlsm").Worksheets("Hugo").Activate
ActiveWindow.SelectedSheets.PrintOut Copies:=1
'Arbeitsblatt Hugo in Offerte kopieren
MappeCopy
'Übergabe Auswertung an Titelblatt
Workbooks("Tempkalk.xlsm").Worksheets("Hugo").Activate
Range("O4:AC4").Select
Selection.Copy
Workbooks("Tempoff.xlsm").Worksheets("Titel").Activate
Range("A26").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Rows("26:26").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown
Range("A27:M27").Select
With Selection.Font
.Name = "Arial"
.Size = 8
End With
Range("C27:M27").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
Selection.NumberFormat = "0.00"
End With
Range("A100").Select
Sheets("Offerte").Select
ActiveWorkbook.Save
Windows("Tempkalk.xlsm").Activate
Application.ScreenUpdating = True
MsgBox "Kalkulation I.O "
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
select und activate?
17.07.2013 10:52:18
Klaus
Hi,
zu xp2013 kann ich nichts sagen, aber du solltest erstmal die ganzen überflüssigen SELECT und ACTIVATE rauswerfen! Warscheinlich sind die der Grund, dass es so langsam läuft.
Der Prozess "copy" "pastespecial" ist auch eher langsam. Schneller ist es, einfach die Werte zuzweisen:
also statt:
If lngRow > 0 Then Sheets("Hugo").Range("C9:C21").Copy
Text_einfügen
lieber:
If lngRow > 0 Then Workbooks("Tempoff.xlsm").Worksheets("Offerte").Cells(lngRow, Spalte).Value = Sheets("Hugo").Range("C9:C21")
Warum du das ganze in eine Function ausgelagert hast kannst du auch nicht erklären, oder?
Das hier:
Function Freien_Platz_suchen()
With Workbooks("Tempoff.xlsm").Worksheets("Offerte")
For Each rng In .Range(cstrRange)
If rng = "" Then
If rng.Offset(1, 0) = "" And Not Intersect(rng.Offset(1, 0), .Range(cstrRange)) Is Nothing Then
If rng.Offset(2, 0) = "" And Not Intersect(rng.Offset(2, 0), .Range(cstrRange)) Is Nothing Then
lngRow = rng.Row + 1
Exit For
End If
End If
End If
Next
End With
End Function

ist, sorry, total daneben! Du gehst hunderte oder tausende von Zellen durch, das dauert Zeit! Die lngRow kann man bestimmt auch ohne Function innerhalb von einer Zeile feststellen! Im Prinzip so:
lngRow = cells(rows.count,1).end(xlup).row
Aber wie genau, dafür müsste man deine Datei kennen.
Im großen und ganzen, Benedikt, hat dein Code ein erhebliches Verbesserungspotential. Ich behaupte einfach mal in den Raum: Wenn dein Code von seinem Ballast befreit und optimiert wird, dann läuft er auch unter xl2013!
Nur: Ohne eine Musterdatei wird dir kaum jemand helfen können. Die Mühe, die Musterdatei auf unter 300kb zu bringen (alles unrelevante raus, lange Datenbereiche auf ein paar dutzend Test-Zeilen eindampfen) wirst du dir machen müssen.
Ausserdem hoffe ich, dass dein Code einigermaßen formatiert und eingerückt in der Datei steht. Was du hier ohne PRE-Tags reingestellt hast, ist eine unlesbare Zumutung.
Grüße,
Klaus M.vdT.

Anzeige
AW: select und activate?
17.07.2013 11:32:19
Benedikt
Lieber Klaus
Danke für deine Rückmeldung. Nehme deine konstruktiven Vorschläge gerne zur Kentnis und versuche das umzusetzen. Wie du aus meinem Level siehst, ist dieser Code zu einem grossen Stück mit Forumshilfe geboren. (Danke an Joseph Ehrensberger).Das ich noch mit activate und select das Werk verpfuschte scheint klar. Trotzdem läuft die Sache einwandfrei und das Tempo ist nicht das Problem.
Weshalb beim ausführen des Macro der Erste Textblock aber in der Adressezeile H4 anstelle von C22 ist doch nicht ganz klar. Umsomehr, da es im Debuggingmodus mit F8 richtig durchläuft.
Sorry für "unlesbare Zumutung"
Gruss und schönen Sommertag Benedikt

Anzeige
AW: select und activate?
17.07.2013 11:39:25
Klaus
  • Weshalb beim ausführen des Macro der Erste Textblock aber in der Adressezeile H4 anstelle von C22 ist doch nicht ganz klar. Umsomehr, da es im Debuggingmodus mit F8 richtig durchläuft.

  • Hi Benedikt,
    gerade wenn man .activate und .select im Code hat, ist debugging oft NICHT das gleiche wie der Codedurchlauf. Im Debug-Modus clickt man gerne mal in eine Tabelle oder sowas, dann ändert sich der Focus und das selection ...
    Stell deinen Code doch mal formatiert hier rein (pre-Tags!) , und markiere die Zeile an der es harkt. Vielleicht seh ich ja was.
    Grüße,
    Klaus M.vdT.
    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige