Microsoft Excel

Herbers Excel/VBA-Archiv

Wer Kann Code ergänzen?



Excel-Version: 8.0 (Office 97)

Betrifft: Wer Kann Code ergänzen?
von: olga
Geschrieben am: 08.06.2002 - 12:16:03

Hallo
Wer kann mir helfen?
Problem:
Datenblatt Eingabe: Bei Eingabe von s soll der Datensatz in Tabellenblatt Sparkasse verschoben werden. Bei Einbabe von r soll der Datensatz in "Raiffeisenbank" verschoben werden.
Das funktioniert gut mit dem Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim z As Long

If Target.Column = 6 Then
If Target.Value = "r" Then
z = Worksheets("Raiffeisen").Cells(65536, 1).End(xlUp).Row + 1

Rows(Target.Row).EntireRow.Copy Destination:=Worksheets("Raiffeisen").Cells(z, 1)
Rows(Target.Row).Delete
Else


If Target.Value = "s" Then

z = Worksheets("Sparkasse").Cells(65536, 1).End(xlUp).Row + 1
Rows(Target.Row).EntireRow.Copy Destination:=Worksheets("Sparkasse").Cells(z, 1)

Rows(Target.Row).Delete

End If
End If

End If
End Sub

Jetzt soll 3 Bankt eingefügt werden. dh.
Bei Eingabe von d soll der Datensatz in Tabellenblatt "Deutsche" verschoben werden, gleichzeitig soll dort in der Spalte 7 aktuelles Datum erscheinen.
Vielen Dank im Voraus

Olga

  

Re: Wer Kann Code ergänzen?
von: Ramses
Geschrieben am: 08.06.2002 - 12:32:35

Hallo Olga,

du musst doch nur deinen Code etwas anpassen


If Target.Value = "d" Then
z = Worksheets("Deutsche").Cells(65536, 1).End(xlUp).Row + 1
Rows(Target.Row).EntireRow.Copy Destination:=Worksheets("Deutsche").Cells(z, 1)
Worksheets("Deutsche").Cells(z, 7) = Format(Now(),"DD.MM.YYYY")
Rows(Target.Row).Delete
End If

Gruss Rainer

  

Re: Wer Kann Code ergänzen?
von: WernerB.
Geschrieben am: 08.06.2002 - 12:38:31

Hallo Olga,

teste doch mal diesen Code:


Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim As Long
    If Target.Column <> 6 Then Exit Sub
    Select Case Target.Value
      Case "d"
        z = Worksheets("Deutsche").Cells(Rows.Count, 1).End(xlUp).Row + 1
        Rows(Target.Row).EntireRow.Copy Destination:=Worksheets("Deutsche").Cells(z, 1)
        Worksheets("Deutsche").Cells(z, 7).Value = Date
        Rows(Target.Row).Delete
      Case "r"
        z = Worksheets("Raiffeisen").Cells(Rows.Count, 1).End(xlUp).Row + 1
        Rows(Target.Row).EntireRow.Copy Destination:=Worksheets("Raiffeisen").Cells(z, 1)
        Rows(Target.Row).Delete
      Case "s"
        z = Worksheets("Sparkasse").Cells(Rows.Count, 1).End(xlUp).Row + 1
        Rows(Target.Row).EntireRow.Copy Destination:=Worksheets("Sparkasse").Cells(z, 1)
        Rows(Target.Row).Delete
    End Select
End Sub

Viel Erfolg wünscht
WernerB.
  

Vielen Dank
von: olga
Geschrieben am: 08.06.2002 - 12:59:27

Vielen Dankt genau so wollte ich es haben.

  

Re: Wer Kann Code ergänzen?
von: olga
Geschrieben am: 08.06.2002 - 13:04:48

Danke, kann ich diese Datensätze in eine externe Datei verschieben z.B.Bezahlte Raiffeisen, Bezahlte Sparkasse, Bezahlte Deutsche?
Vielen Dank
Olga

  

Re: Vielen Dank
von: olga
Geschrieben am: 08.06.2002 - 13:08:56

kann mann diese Datensätze in externe Datei verschieben?
z.B Bezahlte Sparkasse, Bezahlte Raiffeisen, Bezahlte Deutsche.exc
Vielen Dank im Voraus

Olga


  

Wie bekomme ich fettschrift weg
von: olga
Geschrieben am: 08.06.2002 - 13:21:17

Hallo
Datum und s im Datenblatt Riffeisen sind fett und unterstrichen
ich habe folgendes probiert aber es funktioniert nicht.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim z As Long
If Target.Column <> 6 Then Exit Sub
Select Case Target.Value
Case "d"
z = Worksheets("Deutsche").Cells(Rows.Count, 1).End(xlUp).Row + 1
Rows(Target.Row).EntireRow.Copy Destination:=Worksheets("Deutsche").Cells(z, 1)
Worksheets("Deutsche").Cells(z, 7).Value = Date
Selection.Font.Underline = xlUnderlineStyleNone
Selection.Font.Bold = False

Rows(Target.Row).Delete
Case "r"
z = Worksheets("Raiffeisen").Cells(Rows.Count, 1).End(xlUp).Row + 1
Rows(Target.Row).EntireRow.Copy Destination:=Worksheets("Raiffeisen").Cells(z, 1)
Worksheets("Deutsche").Cells(z, 7).Value = Date
Rows(Target.Row).Delete
Case "s"
z = Worksheets("Sparkasse").Cells(Rows.Count, 1).End(xlUp).Row + 1
Rows(Target.Row).EntireRow.Copy Destination:=Worksheets("Sparkasse").Cells(z, 1)
Worksheets("Deutsche").Cells(z, 7).Value = Date
Rows(Target.Row).Delete
End Select
End Sub

  

Re: Vielen Dank
von: WernerB.
Geschrieben am: 08.06.2002 - 13:37:41

Hallo Olga,

die externen Dateien müssen geöffnet(!) sein, dann geht es so (Blattnamen ggf. anpassen):


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim wb As String
Dim As Long
    If Target.Column <> 6 Then Exit Sub
    Select Case Target.Value
      Case "d"
        wb = "Bezahlte Deutsche.xls"
        z = Workbooks(wb).Worksheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row + 1
        Rows(Target.Row).EntireRow.Copy Workbooks(wb).Worksheets("Tabelle1").Cells(z, 1)
        Workbooks(wb).Worksheets("Tabelle1").Cells(z, 7).Value = Date
        Rows(Target.Row).Delete
      Case "r"
        wb = "Bezahlte Raiffeisen.xls"
        z = Workbooks(wb).Worksheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row + 1
        Rows(Target.Row).EntireRow.Copy Workbooks(wb).Worksheets("Tabelle1").Cells(z, 1)
        Rows(Target.Row).Delete
      Case "s"
        wb = "Bezahlte Sparkasse.xls"
        z = Workbooks(wb).Worksheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row + 1
        Rows(Target.Row).EntireRow.Copy Workbooks(wb).Worksheets("Tabelle1").Cells(z, 1)
        Rows(Target.Row).Delete
    End Select
End Sub

Viel Erfolg wünscht
WernerB.
  

Re: Wie bekomme ich fettschrift weg
von: WernerB.
Geschrieben am: 08.06.2002 - 13:48:30

Hallo Olga,

diese Formatierungen sind nicht makrobedingt vorhanden, sondern weil vorher schon jemand an dem Blatt "herumgefummelt" und die entsprechenden Einstellungen vorgenommen hat.

- Markiere die Spalten 6 und 7 (bzw. F und G) des entsprechenden Tabellenblattes
- Bearbeiten / Löschen / Formate
- Markiere die Spalte 7 (bzw. G)
- Format / Zellen / Zahlen / Benutzerdefiniert / "TT.MM.JJJJ" (ohne Anführungszeichen)

MfG
WernerB.


  

Re: Danke
von: olga
Geschrieben am: 09.06.2002 - 21:38:36

Danke