Live-Forum - Die aktuellen Beiträge
Datum
Titel
16.04.2024 12:41:11
Vielleicht Onur ? Leider werden nicht alle Monate
16.04.2024 12:08:33
Zelle/Spalte bestimmten Wert in Kopfzeile zuordnen
16.04.2024 12:01:17
Dynamische Liste generiert aus mehreren Vorgagen
16.04.2024 11:48:22
Blatt in HTML exportieren wenn Checkbox aktiv ist
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1516to1520
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1516to1520
1516to1520
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Makrohilfe

Makrohilfe
11.10.2016 09:47:14
tursiops
Hallo!
Ich benötige etwas Hilfe bei einem Makro. Der Upload einer Beispieldatei hat nicht funktioniert. Ich verwende einen Mac, vielleicht liegt es daran... Die Excelversion wäre dann 2011 für Mac
Beschreibung:
Im Blatt "trans" wird in Zeile 6 ein Datensatz für meine Datenbank in Excel vorbereitet. Derzeit kopiere ich diesen per Hand. Nun sollen weitere Mitarbeiter mit der Datei arbeiten und der Speichervorgang soll etwas benutzerfreundlicher werden.
Das Makro soll folgendes tun:
- Zeile 6 aus Blatt "Trans" kopieren
- im Blatt "U.DB" prüfen, ob in Spalte A bereits ein identischer Wert wie in A6 aus "trans" vorhanden ist
- falls nicht vorhanden soll der Datensatz in die erste freie Zeile des Blattes "U.DB" eingefügt werden
- falls vorhanden soll der bestehende Datensatz überschrieben werden (möglichst mit Warnung vorab)
Für jegliche Hilfe wäre ich dankbar!
Gruß Frank

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makrohilfe
11.10.2016 09:58:43
Rudi
Hallo, 
Sub aaa()
Dim vRow
vRow = Application.Match(Sheets("trans").Range("A6"), Sheets("U.DB").Columns(1), 0)
If IsError(vRow) Then
Sheets("trans").Range("A6").EntireRow.Copy Sheets("U.DB").Cells(Rows.Count, 1).End(xlUp). _
Offset(1)
Else
If MsgBox("Daten bereits vorhanden! Überschreiben?", vbYesNo, "Überschreiben") = vbYes Then
Sheets("trans").Range("A6").EntireRow.Copy Sheets("U.DB").Cells(vRow, 1)
End If
End If
End Sub
Gruß
Rudi
AW: Makrohilfe
11.10.2016 10:11:18
tursiops
Hallo!
Vielen vielen Dank für die schnelle Antwort. Das Makro arbeitet fast perfekt. Eine Sache habe ich nur vergessen, die Werte aus Zeile 6 dürfen nur als Text eingefügt werden. Momentan werden Formeln kopiert, die dann Fehler erzeugen. Kann ich hier nochmals um Hilfe bitten? Bei dem Code sehe ich leider kein Land.
Gruß Frank
Anzeige
AW: Makrohilfe
11.10.2016 12:16:15
Rudi
Hallo, 
Sub aaa()
Dim vRow
Sheets("trans").Range("A6").EntireRow.Copy
vRow = Application.Match(Sheets("trans").Range("A6"), Sheets("U.DB").Columns(1), 0)
If IsError(vRow) Then
Sheets("U.DB").Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
Else
If MsgBox("Daten bereits vorhanden! Überschreiben?", vbYesNo, "Überschreiben") = vbYes Then
Sheets("U.DB").Cells(vRow, 1).PasteSpecial xlPasteValues
End If
End If
End Sub

Gruß
Rudi
AW: Makrohilfe; Ergänzung
11.10.2016 12:17:27
Rudi 

Sub aaa()
Dim vRow
Sheets("trans").Range("A6").EntireRow.Copy
vRow = Application.Match(Sheets("trans").Range("A6"), Sheets("U.DB").Columns(1), 0)
If IsError(vRow) Then
Sheets("U.DB").Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
Else
If MsgBox("Daten bereits vorhanden! Überschreiben?", vbYesNo, "Überschreiben") = vbYes Then
Sheets("U.DB").Cells(vRow, 1).PasteSpecial xlPasteValues
End If
End If
Application.CutCopyMode = False
End Sub

Anzeige
AW: Makrohilfe; Ergänzung
11.10.2016 14:58:08
tursiops
Vielen Dank!!!
Das funktioniert perfekt und hat mir sehr geholfen!
Gruß Frank
AW: Makrohilfe
11.10.2016 10:42:05
UweD
Hallo
das Auslösen des Makros hab ich mal auf einen Rechtsclick gelegt
- Also rechtsclick auf eine Zelle in Spalte A copiert die angeclickte Zeile...
das ginge so...
- Rechtsclick auf den Tabellenblattreiter Trans
- Code anzeigen
- Diesen Code dort reinkopieren
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Range("A:A"), Target) Is Nothing Or Target.Count = 1 Then
        'If Target.Row <> 6 Then Exit Sub ' wenn es nur in A6 klappen soll 
        Dim TB1, TB2, Zeile As Long
        Set TB1 = Sheets("Trans")
        Set TB2 = Sheets("U.DB")
        Cancel = True
        If WorksheetFunction.CountIf(TB2.Columns(1), Target) = 1 Then
            MsgBox "Werte werden überschrieben"
            Zeile = WorksheetFunction.Match(Target, TB2.Columns(1), 0)
        Else
            Zeile = TB2.Cells(TB2.Rows.Count, "A").End(xlUp).Row + 1
        End If
        Rows(Target.Row).Copy TB2.Rows(Zeile)
        With TB2.Rows(Zeile) ' als Wert 
            .Value = .Value
        End With
    End If
End Sub

Wenn es nur Zeile 6 sein soll, dann nimm das ' hier vorne weg
'If Target.Row 6 Then Exit Sub ' wenn es nur in A6 klappen soll
Gruß UweD
Über Rückmeldungen würde ich mich freuen
Anzeige
AW: Makrohilfe
11.10.2016 11:22:19
tursiops
Hallo!
Vielen Dank für die Arbeit. Die Option Rechtsklick ist interessant, jedoch für diesen Zweck nicht besonders effizient. Die Benutzer arbeiten weder im Blatt "trans", noch in der Datenbank. Das Makro wird per Schaltfläche von der Eingabemaske in einem anderen Blatt aus ausgelöst. Daher war der erste Code für mich absolut perfekt. Ich wüßte nur gern, wie ich ihn so verändern kann, dass nur Werte eingefügt werden.
Die Option mit dem Rechtsklick habe ich mir jedoch bereits für ein ganz anderes Projekt vermerkt. Hier ist das eine tolle Lösung, die vieles einfacher macht.
Danke schon einmal vielen Dank!!!
Anzeige
AW: Makrohilfe
11.10.2016 11:33:11
UweD
Dann hier Rudis Makro abgeändert
Sub aaa()
    Dim vRow
    vRow = Application.Match(Sheets("trans").Range("A6"), Sheets("U.DB").Columns(1), 0)
    If IsError(vRow) Then
        Sheets("trans").Range("A6").EntireRow.Copy Sheets("U.DB").Cells(Rows.Count, 1).End(xlUp). _
            Offset(1)
        With Sheets("U.DB").Cells(Rows.Count, 1).End(xlUp).Offset(1)
            .Value = .Value
        End With
    Else
        If MsgBox("Daten bereits vorhanden! Überschreiben?", vbYesNo, "Überschreiben") = vbYes Then
            Sheets("trans").Range("A6").EntireRow.Copy Sheets("U.DB").Cells(vRow, 1)
            With Sheets("U.DB").Cells(vRow, 1)
                .Value = .Value
            End With
        End If
    End If
End Sub

LG UweD
Anzeige
AW: Makrohilfe
11.10.2016 11:37:39
UweD
Mist..
soll ja ganze Zeile als Wert sein
bitte so..
Sub aaa()
    Dim vRow
    vRow = Application.Match(Sheets("trans").Range("A6"), Sheets("U.DB").Columns(1), 0)
    If IsError(vRow) Then
        Sheets("trans").Range("A6").EntireRow.Copy Sheets("U.DB").Cells(Rows.Count, 1).End(xlUp). _
            Offset(1)
        With Sheets("U.DB").Cells(Rows.Count, 1).End(xlUp).Offset(1).EntireRow
            .Value = .Value
        End With
    Else
        If MsgBox("Daten bereits vorhanden! Überschreiben?", vbYesNo, "Überschreiben") = vbYes Then
            Sheets("trans").Range("A6").EntireRow.Copy Sheets("U.DB").Cells(vRow, 1)
            With Sheets("U.DB").Cells(vRow, 1).EntireRow
                .Value = .Value
            End With
        End If
    End If
End Sub

LG UweD
Anzeige
AW: Makrohilfe
11.10.2016 12:06:41
tursiops
Hallo!
Das funktioniert leider noch nicht. Bei einem neuen Datensatz werden weiterhin die Formeln kopiert.
Bei einem bestehenden Datensatz werden nicht immer korrekte Formelergebnisse übernommen. Vermutlich, weil das Format mit übernommen wird. Dies ist hier gar nicht gewünscht.
Mit Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= False, Transpose:=False oder per Hand als Wert einfügen klappt es.
Gruß Frank
AW: Makrohilfe
11.10.2016 13:06:43
tursiops
Ups! Kontrollkästchen vergessen...
Name: tursiops Version: Alle Versionen
Betreff: AW: Makrohilfe Level: Excel-Profi - VBA bescheiden
Hallo!
Das funktioniert leider noch nicht. Bei einem neuen Datensatz werden weiterhin die Formeln kopiert.
Bei einem bestehenden Datensatz werden nicht immer korrekte Formelergebnisse übernommen. Vermutlich, weil das Format mit übernommen wird. Dies ist hier gar nicht gewünscht.
Mit Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= False, Transpose:=False oder per Hand als Wert einfügen klappt es.
Gruß Frank
Anzeige
AW: Makrohilfe
11.10.2016 13:25:39
Werner
Hallo Frank,
du solltest dir vielleicht auch die weiteren Antworten vun Rudi ansehen.
Gruß Werner
AW: Makrohilfe
11.10.2016 14:59:35
tursiops
OK, danke - habe ich scheinbar übersehen!
Gruß Frank
AW: Alles klar, dann passt es ja. o.w.T.
11.10.2016 15:15:57
Werner

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige