Makro funktioniert in einem bestimmten Fall nicht

Bild

Betrifft: Makro funktioniert in einem bestimmten Fall nicht
von: Jenny
Geschrieben am: 18.04.2015 07:29:14

Hallo an alle,
habe ein Problem mit nachfolgendem Makro und bitte euch zu helfen.
In dem Sonderfall, dass sowohl in Tabelle2 Spalte B und Tabelle 3 Spalte D jeweils nur ein Eintrag steht, gibt das Makro Laufzeitfehler 1004 aus, Leider konnte nichts eingefügt werden, da der Kopieren Bereich und der Einfüge Bereich nicht die gleiche Größe haben,
dabei wird beim Debuggen

.Range("B" & von & ":B" & bis).Copy Sheets("Tabelle1").Range("C" & zt1)
markiert.
Ansonsten bei mehr als einem Eintrag macht das Makro was es soll. Kann mir jemand bitte helfen das Makro anzupassen?
LG
Jenny
Sub Makro1()
'
' Makro1 Makro
'
' Tastenkombination: Strg+i
'
Dim zt1, von, bis As Long
Dim Grafiken As Shape
zt1 = Sheets("Tabelle1").Range("A1").SpecialCells(xlCellTypeLastCell).Row
von = 1
bis = Sheets("Tabelle2").Range("B" & von).End(xlDown).Row
With Sheets("Tabelle2")
 .Range("B" & von & ":B" & bis).Copy Sheets("Tabelle1").Range("C" & zt1)
 End With
With Sheets("Tabelle3")
 .Range("E" & von & ":E" & bis).Copy
  End With
With Sheets("Tabelle1")
 .Range("D" & zt1).PasteSpecial (xlValues)
 End With
Application.CutCopyMode = False
With Sheets("Tabelle1")
 .Range("A" & zt1 & ":B" & zt1).Copy .Range("A" & zt1 + 1 & ":A" & zt1 + bis - von)
 End With
Application.CutCopyMode = False
With Sheets("Tabelle1")
 .Range("A1:G" & zt1 + 1 + bis - von).Sort key1:=.Range("D1"), Order1:=xlDescending, Header:= _
xlNo
End With
With Sheets("Tabelle2")
 .Range("A" & von & ":C" & bis).Clear
 End With
With Sheets("Tabelle3")
 .Range("A" & von & ":D" & bis).Clear
  For Each Grafiken In .Shapes
    Grafiken.Delete
  Next
 End With
End Sub

Bild

Betrifft: AW: Makro funktioniert in einem bestimmten Fall nicht
von: fcs
Geschrieben am: 18.04.2015 09:29:29
Hallo Jenny,
das Problem entsteht bei der Berechnung von "bis".
Wenn nur eine Datenzeile vorhanden ist, dann kommt für "bis" als Ergebnis die letzte Zeile der Tabelle heraus - also 1048576. Einen Bereich mit so vielen Zeilen kann Excel dann beim Kopieren nicht im anderen Blatt am Ende der Liste anfügen.
Mit folgender Ergänzung sollte es funktionieren:

bis = Sheets("Tabelle2").Range("B" & von).End(xlDown).Row
If bis = Sheets("Tabelle2").Rows.Count Then bis = von
Gruß
Franz

Bild

Betrifft: AW: Makro funktioniert in einem bestimmten Fall nicht
von: Jenny
Geschrieben am: 18.04.2015 18:28:34
Hallo Franz, vielen Dank, der genannte Fehler ist jetzt weg, aber ein neuer ist aufgetreten, was aber daran liegt dass ich beim Schreiben dieses Beitrags nicht so weit gedacht habe.
Vermutlich diese Zeile hier

.Range("A" & zt1 & ":B" & zt1).Copy .Range("A" & zt1 + 1 & ":A" & zt1 + bis - von)
veranlasst das Makro dazu eine Kopie der letzten Zeile (Spalten A und B) eine Zeile tiefer anzulegen, diese Kopie wird aber nicht benötigt, wie gesagt nur in dem Fall dass vorher nur je eine Zelle aus den Tabellen 2 und 3 kopiert wurde, in dem Fall dass es mehr als eine Zelle ist funktioniert nach wie vor alles wie gewollt.
LG
Jeny

Bild

Betrifft: noch offen
von: Jenny
Geschrieben am: 18.04.2015 18:37:48
noch offen

Bild

Betrifft: AW: Makro funktioniert in einem bestimmten Fall nicht
von: Nepumuk
Geschrieben am: 18.04.2015 10:37:46
Hallo,
1. Ermittle die letzte Zelle besser von unten nach oben. Also:

With Worksheets("Tabelle2")
    bis = .Cells(.Rows.Count, 2).End(xlUp).Row
End With

2. Ist deine Dimensionierung der Variablen Fehlerhaft. Du musst jeder Variablen den Datentyp explizit zuweisen. Nur der letzten Variablen in einer Liste bringt nichts. Also:
Dim zt1 As Long, von As Long, bis As Long

3. Wenn du eine Variable hast die einen unveränderlichen Wert enthält, legst du diese besser als Konstante fest. Also:
Const von As Long = 1

Gruß
Nepumuk

Bild

Betrifft: exakt dasselbe auch mit deinem Vorschlag
von: Jenny
Geschrieben am: 18.04.2015 18:56:49
exakt dasselbe auch mit deinem Vorschlag, wie bei dem anderen Vorschlag

Bild

Betrifft: AW: exakt dasselbe auch mit deinem Vorschlag
von: Nepumuk
Geschrieben am: 18.04.2015 21:53:20
Hallo,
kannst du mal in Worten beschreiben was du erreichen willst, denn ohne die Mappe werde ich aus deinem Code nicht schlau.
Gruß
Nepumuk

Bild

Betrifft: AW: exakt dasselbe auch mit deinem Vorschlag
von: Jenny
Geschrieben am: 18.04.2015 22:27:52
Hallo nepomuk,
danke erstmal auch dir für die Hilfe.
hab nen Beispiel gemacht dass es vlt. ein bisschen erklärt,
das mit dem Sortieren und dem löschen hab ich im Bsp. weggelassen.
LG
Jenny
https://www.herber.de/bbs/user/97153.xlsx

Bild

Betrifft: Dim mehrere Variablen
von: Michael
Geschrieben am: 19.04.2015 16:25:12
Hallo Nepomuk,
ich zitiere aus Deinem Post unter 2:
"Du musst jeder Variablen den Datentyp explizit zuweisen. Nur der letzten Variablen in einer Liste bringt nichts."
Das lese ich hin und wieder, kann es aber nicht so recht nachvollziehen.
Also habe ich mich mal aufgemacht und recherchiert. MS schreibt (allerdings in dem Fall zu VB in VS 2013): https://msdn.microsoft.com/de-de/library/7ee5a7s1.aspx

Dim a, b, c As Single, x, y As Double, i As Integer
' a, b, and c are all Single; x and y are both Double
Falls Du konkrete, anderslautende Infos hast, lasse sie mir bitte zukommen.
Vielen Dank und schöne Grüße,
Michael

Bild

Betrifft: AW: Dim mehrere Variablen
von: Nepumuk
Geschrieben am: 19.04.2015 16:34:51
Hallo,
dann schreib das mal in eine Prozedur, starte sie mit F8 und schau dir die Datentypen im Lokalfenster (Menüleiste - Ansicht - Lokalfenster) an. Da siehst du dass a, b und x ein Variant ist.
Die Beschreibung von Microsoft bezieht sich auch nicht auf VBA sondern auf VB.net.
Wenn du dir die Beschreibung für VBA ansiehst: https://msdn.microsoft.com/de-de/library/office/gg251750(v=office.15).aspx
dann kannst du da lesen: Verwenden Sie eine eigene As type-Klausel für jede Variable, die Sie deklarieren.
Gruß
Nepumuk

Bild

Betrifft: AW: Dim mehrere Variablen
von: Michael
Geschrieben am: 19.04.2015 18:12:38
Hallo Nepomuk,
besten Dank für Deine Mühe!
Macht mich echt fertig: das hab ich quasi *noch nie* richtig gemacht!
Gruß,
Michael

Bild

Betrifft: Da scheinst du auf ein ziemlich merkwürdiges ...
von: Luc:-?
Geschrieben am: 19.04.2015 00:32:52
…Phänomen gestoßen zu sein, Jenny,
was ich mit folgender Prozedur untersucht habe:

Sub testJenny()
    Const von As Long = 1
    Dim zt1 As Long, bis As Long
    zt1 = Sheets("Tabelle3").Range("B" & CStr(von)).SpecialCells(xlCellTypeLastCell).Row
    bis = Sheets("Tabelle2").Range("B" & CStr(von)).SpecialCells(xlCellTypeLastCell).Row
    Sheets("Tabelle2").Range("B" & CStr(von) & ":B" & _
        CStr(bis)).Copy Sheets("Tabelle3").Range("C" & CStr(zt1))
End Sub
Obwohl das nagelneue Blatt3 bis auf einen Eintrag in A1 völlig leer war, erhielt zt1 stets den Wert 12. Nachdem ich Blatt 2 auf Blatt 3 kopiert hatte, beide also völlig identisch hätten sein müssen, wurde zt1 sogar noch größer. Erst als ich die ersten 25 Zeilen beider Blätter gelöscht hatte und jeweils in B1 eine 1 eingetragen hatte, erhielt auch zt1 mit dem angepassten Code endlich den Wert 1. Und das blieb auch nach einer Wiederholung des Ganzen so.
Mit dem OriginalPgm ergab sich für bis ohnehin ein völlig falscher Wert, der wohl der letzt­möglichen Zeile entsprach, eine Beobachtung, die ich bei diesem Konstrukt auch schon früher unter Xl12/2007 gemacht hatte. Der Befehl scheint jetzt tatsächlich so zu fktionieren, wie man es aus seinem Text schließen kann und stets (bzw unter best Umständen) die letzt­mögliche Zelle der Spalte wiederzugeben.
Ich vermute deshalb einer­seits diese bestimmten Umstände und anderer­seits ein nicht wirklich ab der einen belegten (ersten?) Zeile völlig leeres Blatt, auch, wenn es so aussehen mag. Dadurch überschreitet die Größe des kopierten Bereichs die Größe des ab zt1 noch zV stehenden Bereichs, was dann zu dieser leicht irreführenden Fehler­meldung führt.
Fazit: Es sollte immer darauf geachtet wdn, dass scheinbar leere Zellen auch tatsächlich völlig leer sind (notfalls nach der letzten Zeile/Spalte einige Zeilen/Spalten löschen!). Außerdem sollte ein solches Pgm schrittweise getestet wdn, um zu sehen, welche Werte die Variablen annehmen. Denn auch, wenn es zu fktionieren scheint, können diese falsch sein, was beim nächsten Mal zu Problemen (weiteren) führen kann. Hier aus der Vielzahl der Möglichkeiten dann die geeignetste wählen!
Gruß + schöSo, Luc :-?

Bild

Betrifft: AW: Da scheinst du auf ein ziemlich merkwürdiges ...
von: Jenny
Geschrieben am: 19.04.2015 07:56:44
Hallo Luc,
wäre das Problem denn nicht einfach lösbar, indem man überprüft wieviele Zeilen in Tabelle2 stehen (Tabelle3 hat immer die identische Zeilenzahl) und wenn es 1 ist, den Teil, in dem Tabelle1 A und B nach unten kopiert wird übergeht?
LG
Jenny

Bild

Betrifft: Allerdings ist Nepumuks Vorschlag ...
von: Luc:-?
Geschrieben am: 19.04.2015 11:05:23
bis = .Cells(.Rows.Count, 2).End(xlUp).Row ohnehin auch richtiger, Jenny;
allerdings könnte es auch dann zu dem beschriebenen „Phänomen“ kommen, aber das sehe ich mir später noch mal an (ebenso wie deine neuerliche Idee).
Gruß+schöSo, Luc :-?

Bild

Betrifft: AW: Allerdings ist Nepumuks Vorschlag ...
von: Jenny
Geschrieben am: 19.04.2015 11:38:23
Hallo Luc,
habe Nepomuks Vorschläge alle umgesetzt, das Problem besteht weiterhin.
LG
Jenny

Bild

Betrifft: falsche Datei?
von: Jenny
Geschrieben am: 19.04.2015 11:40:24
wenn ich die Mappe von hier aus öffnen will, öffnet sich eine Datei die ich eigentlich für einen anderen Beitrag hochgeladen hatte, hier nochmal die richtige
https://www.herber.de/bbs/user/97155.xlsx

Bild

Betrifft: Das passiert gelegentlich, ...
von: Luc:-?
Geschrieben am: 19.04.2015 13:13:56
…Jenny;
möglicherweise hat die UpLoad-Software Nummerierungs­probleme, wodurch mitunter Dateien verloren gehen dürften. Die DownLoad-Software „vermutet“ dann (wenn sie die Datei nicht findet) wohl einen Zahlendreher und verwendet die (bei entsprd Korrektur) zu findende.
Luc :-?

Bild

Betrifft: AW: falsche Datei?
von: fcs
Geschrieben am: 20.04.2015 07:51:01
Hallo Jenny,
nach folgend dein Makro umgeschrieben, es funktioniert.
In Tabelle3 der Beispiel stehen die Beispieldaten in Spalte E! Laut Makro sollen sie in D stehen.
Gruß
Franz

Sub Makro1()
    '
    ' Makro1 Makro
    '
    ' Tastenkombination: Strg+i
    '
    Dim zt1, von, bis As Long
    Dim Grafiken As Shape
    Application.ScreenUpdating = False
    With Sheets("Tabelle1")
        zt1 = .Cells(.Rows.Count, 1).End(xlUp).Row
        von = 1
        With Sheets("Tabelle2")
            bis = .Cells(.Rows.Count, 2).End(xlUp).Row
            'Inhalt Spalte B nach tabelle1 kopieren
            .Range(.Cells(von, 2), .Cells(bis, 2)).Copy Sheets("Tabelle1").Cells(zt1, 3)
        End With
        With Sheets("Tabelle3")
            'Inhalt aus Spalte D kopieren ????  oder aus Spalte E ???? _
                 'In der Beispiel-Datei stehn die Daten in Spalte E!!!
            .Range(.Cells(von, 4), .Cells(bis, 4)).Copy
        End With
        'In Spalte D einfügen
        .Cells(zt1, 4).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        'Spalte A und B durch kopieren auffüllen
        .Range(.Cells(zt1, 1), .Cells(zt1, 2)).Copy _
             .Range(.Cells(zt1 + 1, 1), .Cells(zt1 + bis - von, 1))
        Application.CutCopyMode = False
        'Daten nach Spalte D absteigend sortieren
        .Range(.Cells(1, 1), .Cells(zt1 + 1 + bis - von, 7)).Sort _
            key1:=.Range("D1"), Order1:=xlDescending, Header:=xlNo
    End With
    With Sheets("Tabelle2")
        'Daten in Spalten A bis C löschen
        .Range(.Cells(1, 1), .Cells(bis, 3)).Clear
    End With
    With Sheets("Tabelle3")
        'Daten in Spalten A bis D (oder doch E???) löschen
     .Range(.Cells(1, 1), .Cells(bis, 4)).Clear
      For Each Grafiken In .Shapes
            Grafiken.Delete
      Next
    End With
    Application.ScreenUpdating = True
End Sub


Bild

Betrifft: AW: falsche Datei?
von: Jenny
Geschrieben am: 20.04.2015 10:01:48
Hallo Franz,
danke erstmal.
das wundert mich jetzt selbst, in Spalte E steht eine Formel, die das was in Spalte D steht umrechnen soll in das was ich brauche, demnach soll E kopiert werden.
Es soll aber nur Spalte A bis D gelöscht werden, weil sonst ja auch die Formeln zum umrechnen weg wären.
Außerdem sagt er mir Syntaxfehler in


        .Range(.Cells(zt1, 1), .Cells(zt1, 2)).Copy _
             .Range(.Cells(zt1 + 1, 1), .Cells(zt1 + bis - von, 1))

LG
Jenny

Bild

Betrifft: AW: falsche Datei?
von: fcs
Geschrieben am: 20.04.2015 15:45:31
Hallo Jenny,
den Syntax-Fehler versstehe ich jetzt nicht denn ich hatte nur den Zeilenumbruch " _" nachträglich eingebaut.Probiere mal folgendes

Sub Makro1()
    '
    ' Tastenkombination: Strg+i
    '
    Dim zt1, von, bis As Long
    Dim Grafiken As Shape
    Application.ScreenUpdating = False
    With Sheets("Tabelle1")
        zt1 = .Cells(.Rows.Count, 1).End(xlUp).Row
        von = 1
        With Sheets("Tabelle2")
            bis = .Cells(.Rows.Count, 2).End(xlUp).Row
            'Inhalt Spalte B nach tabelle1 kopieren
            .Range(.Cells(von, 2), .Cells(bis, 2)).Copy Sheets("Tabelle1").Cells(zt1, 3)
        End With
        With Sheets("Tabelle3")
            'Inhalt aus Spalte E kopieren
            .Range(.Cells(von, 5), .Cells(bis, 5)).Copy
        End With
        'In Spalte D einfügen
        .Cells(zt1, 4).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        'Spalte A und B durch kopieren auffüllen
        .Range(.Cells(zt1, 1), .Cells(zt1, 2)).Copy _
             Destination:=.Range(.Cells(zt1 + 1, 1), .Cells(zt1 + bis - von, 1))
        Application.CutCopyMode = False
        'Daten nach Spalte D absteigend sortieren
        .Range(.Cells(1, 1), .Cells(zt1 + 1 + bis - von, 7)).Sort _
            key1:=.Range("D1"), Order1:=xlDescending, Header:=xlNo
    End With
    With Sheets("Tabelle2")
        'Daten in Spalten A bis C löschen
        .Range(.Cells(1, 1), .Cells(bis, 3)).Clear
    End With
    With Sheets("Tabelle3")
        'Daten in Spalten A bis D  löschen
     .Range(.Cells(1, 1), .Cells(bis, 4)).Clear
      For Each Grafiken In .Shapes
            Grafiken.Delete
      Next
    End With
    Application.ScreenUpdating = True
End Sub


Bild

Betrifft: AW: falsche Datei?
von: Jenny
Geschrieben am: 20.04.2015 19:20:44
Hallo Franz,
der Syntaxfehler ist weg, aber das eigentliche Problem besteht immer noch, wenn nach dem Kopieren aus T2 und 3 die letzte Zeile in Tabelle1 in allen 4 Spalten dieselbe ist, schreibt er das was in der letzten Zeile in A und B steht in eine weitere Zeile und das brauche ich nicht.
Dies passiert, wenn in T2 und 3 jeweils nur eine Zelle zum Kopieren da war.
Ist mehr als eine Zelle da zum kopieren läuft alles wie gewünscht, nämlich dass die Texte in Spalte A und B nicht bis zum Ende der Tabelle reichen und dann die letzten vorhandenen Texte bis zum Schluss der Tabelle kopiert werden sollen.
aber notfalls fällt mir auch ein Workaround ein, der allerdings das Problem nur umgeht, nicht löst.
Ganz am Anfang des Makros überprüfen lassen wieviele Texte in Tabelle2, Spalte B stehen und wenn nur eins, dann am Ende des Makros die letzte zeile in Tabelle1 löschen. Das Umgeht das was das Makro anstellt zumindest, auch wenn es nicht verhindert dass diese Zeile überhaupt erstellt wird.
LG
Jenny

Bild

Betrifft: AW: falsche Datei?
von: fcs
Geschrieben am: 21.04.2015 06:55:28
Hallo Jenny,
dann muss das Kopieren der Zeilen in Spalte A:B in eine Prüfung gepackt werden werden, ob "bis" > 1 ist


        If bis > 1 then
          'Spalte A und B durch kopieren auffüllen
          .Range(.Cells(zt1, 1), .Cells(zt1, 2)).Copy _
              Destination:=.Range(.Cells(zt1 + 1, 1), .Cells(zt1 + bis - von, 1))
        End If

Gruß
Franz

Bild

Betrifft: AW: falsche Datei?
von: Jenny
Geschrieben am: 21.04.2015 07:05:17
Hallo Franz,
dankeschön. Jetzt funktioniert es.
LG
Jenny

Bild

Betrifft: AW: falsche Datei?
von: Jenny
Geschrieben am: 21.04.2015 07:06:08
Hallo Franz,
dankeschön. Jetzt funktioniert es.
LG
Jenny

Bild

Betrifft: AW: Makro funktioniert in einem bestimmten Fall nicht
von: Gerd L
Geschrieben am: 19.04.2015 18:15:47
Hallo Jenny,
deine Prozedur bei der Ermittlung der Schlusszeilen geändert u. etwas entkernt.

Sub Makro2()
Const von As Long = 1
Dim zt1 As Long, bis As Long
Dim Grafiken As Shape
             
             
zt1 = Sheets("Tabelle1").Cells(Sheets("Tabelle1").Rows.Count, 1).End(xlUp).Row
bis = Sheets("Tabelle2").Cells(Sheets("Tabelle2").Rows.Count, 2).End(xlUp).Row
Sheets("Tabelle2").Range("B" & von & ":B" & bis).Copy Sheets("Tabelle1").Range("C" & zt1)
Sheets("Tabelle3").Range("E" & von & ":E" & bis).Copy
Sheets("Tabelle1").Range("D" & zt1).PasteSpecial (xlValues)
Application.CutCopyMode = False
Sheets("Tabelle1").Range("A" & zt1 & ":B" & zt1).Copy Sheets("Tabelle1").Range("A" & zt1 + 1 & " _
:A" & zt1 + bis - von)
Application.CutCopyMode = False
Sheets("Tabelle1").Range("A1:G" & zt1 + 1 + bis - von).Sort key1:=Sheets("Tabelle1").Range("D1") _
, Order1:=xlDescending, Header:= _
xlNo
Sheets("Tabelle2").Range("A" & von & ":C" & bis).Clear
Sheets("Tabelle3").Range("A" & von & ":D" & bis).Clear
For Each Grafiken In Sheets("Tabelle3").Shapes
   Grafiken.Delete
Next
End Sub
Gruß Gerd

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Makro funktioniert in einem bestimmten Fall nicht"