Anzeige
Archiv - Navigation
936to940
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
936to940
936to940
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro Erweiterung

Makro Erweiterung
27.12.2007 14:12:00
Rolf
Hallo
Wünsche ein frohes Weihnachtsfest gehabt zu haben.
Jetzt zu meinem Anliegen:
Vor einigen Jahren habe ich ein Makro von Herber bekommen, es funktioniert wunderbar. Leider weiss ich nicht mehr, von wem. Beim nächsten Mal werde ich den Namen dazuschreiben.
Dieses Makro ist einer der berühmten Dreizeiler, der es in sich hat.
Es macht folgendes:
• Daten aus einen Datenbank („Stammdaten“) (Name, Geburtsdatum usw.) sollen gelöscht und in eine andere („Gelöscht“) übertragen werden.
• Gelöscht werden dürfen aber nur die Eingaben von Hand, nicht die Berechnungen (Alter usw.).
• Vorher fragt dieses Makro, ob ich auch sicher bin.
Das funktioniert gut.
Jetzt die Änderung:
• Es soll vorher gefragt werden, ob die alten Eintragungen gelöscht werden sollen oder nicht.
• Das ist nötig um festzustellen, wer korrekt gekündigt hat oder wegen Beitrags-Lücken gekündigt wurde.
• Trotzdem sollen sie in das neue Tabellenblatt kopiert werden.
• Die Abfrage soll lauten: Alten Eintrag löschen...nicht löschen...Abbrechen
• Eine Kontrolle auf doppelte Eintragung ist nötig.
Als Anlage sende ich einen Auszug mit dem Makro zum Testen.
Gruss Rolf K.
https://www.herber.de/bbs/user/48651.xls

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro Erweiterung
27.12.2007 15:03:50
Josef
Hallo Rolf,
ersetze deinen Code mal durch diesen.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************


Sub Stammdaten_Loeschen_und_kopieren()
Dim objWB As Worksheet, rng As Range
Dim lngR As Long
Dim r As Long, bDelete As Boolean

ActiveSheet.Unprotect

lngR = ActiveCell.Row

If MsgBox("Wollen Sie den Eintrag" & Space(45) & vbLf & vbLf & vbTab & _
    "Nummer:" & vbTab & Cells(lngR, 1) & vbLf & vbTab & _
    "Name:" & vbTab & Cells(lngR, 3) & " " & Cells(lngR, 2) & vbLf & vbLf & _
    "wirklich löschen?", vbQuestion + vbYesNo, "Bestätigung") = vbYes Then
    
    r = MsgBox("Alte Daten löschen?", vbQuestion + vbYesNoCancel, "Löschen")
    
    If r = vbCancel Then Exit Sub
    
    bDelete = r = vbYes
    
    On Error Resume Next
    Set rng = Rows(lngR).SpecialCells(xlCellTypeConstants)
    On Error GoTo 0
    
    If Not rng Is Nothing Then
        
        Set objWB = Sheets("Gelöscht")
        
        objWB.Unprotect
        
        
        rng.Copy objWB.Cells(Application.Max(2, objWB.Cells(Rows.Count, 1).End(xlUp).Row + 1), 1)
        
        If bDelete Then rng.Delete
        
        objWB.Protect _
            DrawingObjects:=True, _
            Contents:=True, _
            Scenarios:=True
        
    End If
End If

ActiveSheet.Protect _
    DrawingObjects:=True, _
    Contents:=True, _
    Scenarios:=True

Set rng = Nothing
Set objWB = Nothing
End Sub

Gruß Sepp

Anzeige
AW: Hat funktiomiert
27.12.2007 20:49:00
Rolf
Hallo Sepp
Das Testen deines Makro hat etwas gedauert.
Ich habe viel daraus gelernt, so dass ich aus den beiden Makro's eines machen konnte.
Guten Rutsch
Rolf K.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige