Excel Makro

Dieses Thema Excel Makro im Forum "Windows XP Forum" wurde erstellt von Miniturtle, 29. Apr. 2011.

Thema: Excel Makro Hallo! Ich suche ein Makro das eine gesamte Zeile (irgendwo in der Excel-Tabelle) z.B. in die Zeile 8 verschiebt...

  1. Hallo!

    Ich suche ein Makro das eine gesamte Zeile (irgendwo in der Excel-Tabelle) z.B. in die Zeile 8 verschiebt wenn in deren Spalte 1 sich eine 6 (sechs) befindet. Zusätzlich soll die gesamte Zeile 10 gelöscht werden wenn sich in der Spalte 1 eine 0 (null) befindet.

    Was natürlich total genial wäre ist dass die gelöschten Zeilen der Reihe nach in ein neues Tabellenblatt Gefertigt (in der gleichen Arbeitsmappe) wieder eingefügt werden! So könnte man sehen was man noch fertigen muss und was schon gefertigt ist!

    Ich habe auch schon ein Makro das die gesamte Zeile 8 löscht wenn sich in der Spalte 1 eine 0 (null) befindet aber leider funktioniert das Makro nicht wenn Excel im Hintergrund läuft, was bei mir der Fall ist! Kann man vielleicht das Makro mit einer Tastaturkombination oder ähnliches manuell erneut starten???

    Kann man diese Arbeitsmappe beim Beenden von Excel automatisch speichern, so dass keine Daten noch zu fertigen und gefertigt verloren gehen???

    MfG Maik Schildwächter
     
  2. Hallo Miniturtle.

    welche Zeile 10 ist denn gemeint - vor oder nach der Verschiebung ?

    Gruß Matjes :)
     
  3. Hallo Miniturtle,

    hab mal einen Prototypen zusammengebaut. Die Funktion ist im Kopf beschrieben.
    Mach eine Kopie deiner Daten und probier ihn aus.

    Zuweisung eine Shortcuts:
    a) Alt+F8 öffnet den Makro-Dialog
    b) Makro markieren
    c) Button Optionen-> Shortcut zuweisen

    Gruß matjes :)
    Code:
    Option Explicit
    
    Sub ZeileBearneiten()
    
    '*** Es wird zunächst geprüft, ob eine Zeile selektiert ist (oder Zellen einer Zeile).
    '*** Sind mehrere Zeilen selektiert, wird eine entsprechende Meldung ausgegeben und der Makro beendet.
    '*** Es wird weiterhin geprüft, ob die Zeilenr gleich der Zielzeilennummer ist.
    '*** Ist das der Fall, wird eine entsprechende Meldung ausgegeben und der Makro beendet.
    '***
    '*** Dann wird geprüft, ob diese Zeile in Spalte A den Wert 6 enthält.
    '*** Ist das nicht der Fall ist die Bearbeitung beendet.
    '*** Andernfalls wird die Zeile an Zeile 8 verschoben.
    '*** In diesem Fall wird auch geprüft, ob Zeile 10 in Spalte A der Wert 0 enthält.
    '*** Wenn ja, wird geprüft ob das Blatt->gefertigt' vorhanden ist.
    '*** Ist es nicht vorhanden, wird es angelegt (nach dem aktuellen Blatt).
    '*** Auf diese Blatt wird die Zeile 10 an Zeile 2 eingefügt und im Ursprungsblatt gelöscht.
    '*** Zum Schluß könnte man speichern (ist auskommentiert)
     
     Const c_SP_PRUEFE_WERT = 1
     Const c_Z_VERSCH = 8
     Const c_Z_VERSCH_WERT = 6
     Const c_Z_LOE = 10
     Const c_Z_LOE_WERT = 0
    
     Const c_BLT_NAME_GEFERTIGT = gefertigt
     Const c_GEFERTIGT_Z_EINFUEGEN = 2
    
     Dim wb As Workbook, ws As Worksheet, wsx As Worksheet, wsz As Worksheet
     Dim x As Long, lZeileAktuell As Long
     
    ->prüfen, ob im aktuellen Blatt nur Zellen einer Zeile selektiert sind
     If Selection.Rows.Count <> 1 Then MsgBox Mehr als eine Zeile selektiert: GoTo AUFRAEUMEN
    ->selektierte Zeile merken
     lZeileAktuell = Selection.Row
     
    ->aktives Blatt setzen
     Set ws = ActiveSheet
     
    ->prüfen, ob Zelle in Spalte A den Wert 6 enthält
     If ws.Cells(lZeileAktuell, c_SP_PRUEFE_WERT).Value <> c_Z_VERSCH_WERT Then GoTo AUFRAEUMEN
      
    ->Bildschirm-Update anhalten
     Application.ScreenUpdating = False
     
    ->Zeile an Zeile 8 verschieben
     ws.Rows(c_Z_VERSCH).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
     If lZeileAktuell >= c_Z_VERSCH Then lZeileAktuell = lZeileAktuell + 1
     ws.Rows(lZeileAktuell).EntireRow.Cut Destination:=ws.Cells(c_Z_VERSCH, 1)
     ws.Rows(lZeileAktuell).Delete Shift:=xlUp
     Application.CutCopyMode = False
    
    ->Prüfen, ob in Zeile 10 die Zelle in Spalte A den Wert 0 hat. Wenn nein, Bearbeitungsende
     If ws.Cells(c_Z_LOE, c_SP_PRUEFE_WERT).Value <> c_Z_LOE_WERT Then GoTo AUFRAEUMEN
     
    ->Blatt->Geferitg' setzen
     Set wb = ws.Parent
     For x = 1 To wb.Worksheets.Count
      If LCase(c_BLT_NAME_GEFERTIGT) = LCase(wb.Worksheets(x).Name) Then Set wsz = wb.Worksheets(x)
     Next
    ->Blatt nicht vorhanden -> erzeugen
     If wsz Is Nothing Then Set wsz = wb.Worksheets.Add(After:=ws): wsz.Name = c_BLT_NAME_GEFERTIGT
      
    ->Zeile 10 ausschneiden und auf Blatt->gefertigt' in Zeile 2 einfügen
     wsz.Rows(c_GEFERTIGT_Z_EINFUEGEN).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
     ws.Rows(c_Z_LOE).EntireRow.Cut Destination:=wsz.Cells(c_GEFERTIGT_Z_EINFUEGEN, 1)
     ws.Rows(c_Z_LOE).Delete Shift:=xlUp
     Application.CutCopyMode = False
      
    ->ursprüngliches Blatt in den Vordergrund
     ws.Activate
     
    ->Bildschirm-Update fortsezen
     Application.ScreenUpdating = True
     
    ->hier könnte man speichern (ist auskommentiert)
    ->wb.save
      
    AUFRAEUMEN:
     Set wb = Nothing: Set ws = Nothing: Set wsz = Nothing
    End Sub
     
Die Seite wird geladen...

Excel Makro - Ähnliche Themen

Forum Datum
Excel VBA Makro zum suchen eines Textes und anschließend einen Breich zu kopieren Microsoft Office Suite 22. Jan. 2015
Excel VBA Makro zum suchen und markieren von Zeilen die ein bestimmtes Wort enthalten Microsoft Office Suite 16. Juni 2014
Excel: Makro ASCII verschieben Windows XP Forum 8. Nov. 2013
Makros und anderes - Excel Microsoft Office Suite 15. März 2013
Excel Sprungmarke mitten in ein anderes Makro Windows XP Forum 15. März 2012