Live-Forum - Die aktuellen Beiträge
Datum
Titel
08.05.2024 21:22:24
In vorhandener Formel Jahreszahl mit einbeziehen
08.05.2024 21:15:37
Koordinaten im XY-Diagramm per Cursor ändern.
08.05.2024 19:10:09
doppelte Zeile gem. mehrerer Bedingungen löschen?
08.05.2024 17:16:08
Randomize, RND, Timer() , (@Onur, Opawinni)
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1940to1944
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
1940to1944
1940to1944
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

VBA? wenn?

VBA? wenn?
14.08.2023 20:22:02
Peter
Hallo,

habe da mal ein kleines/großes Problem.

Habe mir ein Aktien-Depot gebastelt.
Nun möchte ich gern, wenn man ein Wert verkauft, das er auf eine vorhandenes Tabellenblatt kopiert wird ab A10

Dieser Vorgang wird ausgelösst durch ein X in P5:P21, gleichzeitig wird in Q5:Q21 das aktuelle Datum gesetzt.
Der Wert soll komplett in das andere Tabellenblatt kopiert werden. z.B. A8:Q8. Der Wert wird in dem Tabellenblatt gelöscht.
Das andere Tab Blatt ist benannt nach der ISIN Nummer.

Versuche mal eine Datei hoch zu laden.
Danke

Gruß Pitt

https://www.herber.de/bbs/user/162331.xlsm

16
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA? wenn?
14.08.2023 22:59:10
ralf_b
ich denke hier direkt an das worksheet_change() event.
aber du denkst sicher: wo ist der fertige Code? Denn "Kaum Excel/VBA-Kenntnisse" lassen keinen anderen Schluss zu.
Noch einige Hinweise zur Verwendung von intelligenten Tabellen.
- Keine leeren Zeilen
- Deine Ergebniszeile ist überflüssig, weil bei intelligenten Tabellen eine Ergebniszeile bereits vorgesehen ist. Muß man nur aktivieren und fertig.

zum lösungsvorschlag: 
Private Sub Worksheet_Change(ByVal Target As Range)

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim indx&, lrow&

  

  If Not Intersect(Target, Range("Tabelle7[X]")) Is Nothing Then

     If Target.Text = "X" Then

        Application.EnableEvents = False

          Target.Offset(, 1).Value = Date

        Application.EnableEvents = True

        With Target.ListObject

          indx = Target.Row - .HeaderRowRange.Row

          lrow = Worksheets(.ListColumns("ISIN/WKN").Range(indx).Text).UsedRange.SpecialCells(xlCellTypeLastCell).Row

          .ListRows(indx).Range.Copy Worksheets(.ListColumns("ISIN/WKN").Range(indx).Text).Cells(IIf(lrow = 1, lrow, lrow + 1))

          .ListRows(indx).Delete

        End With

     End If

  End If

  

End Sub
Anzeige
VBA? wenn?
15.08.2023 15:58:28
Peter
Hallo ralf_b

tut mir leid, das ich so wenig davon verstehe.
Danke, das Du überhaupt geantwortet hast.

Leider geht es nicht.
Wenn ich das X eingebe passiert nichts.

Vieleicht magst Du noch mal draufschauen.

Danke

Gruß Pitt
AW: VBA? wenn?
15.08.2023 17:58:35
ralf_b
bis auf die versehentlich doppelte kopfzeile 
Private Sub Worksheet_Change(ByVal Target As Range)

Private Sub Worksheet_Change(ByVal Target As Range)


wüßte ich nicht was ich da noch ändern sollte. denn ich hab es bei mir erfolgreich ausprobiert.
VBA? wenn?
15.08.2023 19:38:58
Peter
Moin,

leider geht es bei mir nicht, bekomme immer ein Fehlermeldung.

https://www.herber.de/bbs/user/162348.xlsm

Habe die Datei hochgeladen mit dem Fehler drin.

Vielleicht magst Du noch mal schauen.
Danke

Gruß Pitt
Anzeige
AW: VBA? wenn?
15.08.2023 20:52:21
ralf_b
deine TAbelle hat eine andern Namen, Ein kleines x ist kein großes X, und Spaltenamen müssen auch übereinstimmen wenn man sie verwendet. 

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim indx&, lrow&, shName$

  

  If Not Intersect(Target, Range("Mitarbeiter[X]")) Is Nothing Then

     If UCase(Target.Text) = "X" Then

        Application.EnableEvents = False

          Target.Offset(, 1).Value = Date

        Application.EnableEvents = True

        With Target.ListObject

          indx = Target.Row - .HeaderRowRange.Row

          shName = .ListRows(indx).Range(.ListColumns("ISIN/WPK").Index).Text

          lrow = Worksheets(shName).Cells(1, 1).End(xlUp).Row

          .ListRows(indx).Range.Copy Worksheets(shName).Cells(IIf(lrow = 1, lrow, lrow + 1))

          .ListRows(indx).Delete

        End With

     End If

  End If

  

End Sub
Anzeige
AW: VBA? wenn?
15.08.2023 22:51:43
ralf_b
so, hier mal eine verbesserte Version, die auch noch das betreffende Worksheet erzeugt falls nicht vorhanden und die Tabellenüberschrift mit übernimmt.
Ein Fehler bei der Zeilenzählung habe ich noch gefunden und hoffentlich nun behoben.
Es werden die Werte und Zahlenformate kopiert, damit auch die Formelergebnisse als Werte erhalten werden. 

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim indx&, lrow&, shName$, sh As Worksheet

  

  If Not Intersect(Target, Range("Mitarbeiter[X]")) Is Nothing Then

     If UCase(Target.Text) = "X" Then

        Application.EnableEvents = False

          Target.Offset(, 1).Value = Date

        Application.EnableEvents = True

        With Target.ListObject

          indx = Target.Row - .HeaderRowRange.Row

          shName = .ListRows(indx).Range(.ListColumns("ISIN/WPK").Index).Text

          On Local Error Resume Next

          Set sh = Worksheets(shName)

          If Err > 0 Then

              Set sh = Worksheets.Add(After:=Worksheets(Worksheets.Count))

              .HeaderRowRange.Copy sh.Cells(1, 1)

              sh.Name = shName

              lrow = 2

              On Error GoTo 0

          Else

              lrow = sh.Cells(1, 1).End(xlDown).Row

              If lrow = 1 And sh.Cells(1, 1) = "" Then

                 .HeaderRowRange.Copy sh.Cells(1, 1)

                 lrow = 2

               Else

                 lrow = lrow + 1

               End If

          End If

          

          .ListRows(indx).Range.Copy

          sh.Cells(lrow, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

          .ListRows(indx).Delete

        End With

         Set sh = Nothing

     End If

  End If

  

End Sub
Anzeige
VBA? wenn?
16.08.2023 14:47:00
Peter
Hallo ralf_b

leider geht das überhaupt nicht.
Habe die gleiche Exceldatei genommen, die ich rein gestellt habe.

Der Bereich nennt sich "Mitarbeiter" und die Tabelle geht von B2: L17.
Das x ob ich es groß oder klein schreibe, leider keine Auswirkung

Gruß Pitt
VBA? wenn?
17.08.2023 12:54:08
Peter
Moin ralf_b

Das klappt jetzt besser.
Vielen Dank für Deine Geduld.

Habe nach dem copy die Anfangszeile geändert. Er fängt jetzt bei A10 an. Das ist so gewollt.
In den ersten Zeilen stehen die Daten drin, worüber er die Daten im Internet abruft.
Das Problem dabei ist: Wenn das Tabellenblatt vorhanden ist, so schreibt er mir da nichts rein, und erfindet eins.
Das sollte nicht passieren.

Wenn das Tabellenblatt vorhanden ist, soll er es darein schreiben, sollte kein Tabellenblatt vorhanden sein, so kann er ein neues erstellen.

Vielleicht kannst Du es nochmal ändern.

Danke

Gruß Pitt
https://www.herber.de/bbs/user/162364.xlsm

Anzeige
AW: VBA? wenn?
17.08.2023 18:17:13
ralf_b
Ich weis nicht was du damit meinst das er ein Tabellenblatt "erfindet". Ich habe dir ein funktionierendes Makro gegeben. Wenn du das kaputt machst, ist das dein Ding.
"Wenn das Tabellenblatt vorhanden ist, soll er es darein schreiben, sollte kein Tabellenblatt vorhanden sein, so kann er ein neues erstellen."
Genau das macht mein Makro. Und das war noch nicht mal Inhalt der Aufgabe.

Das ist mein letztes Geschenk für diesen Anwendungsfall. Mach es nicht nochmal kaputt. Jede weitere Anfrage klären wir gern per Email, dann werden wir uns sicher einig. 

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim indx&, lrow&, shName$, sh As Worksheet

  Const POSHEADLINE& = 10

  



  If Not Intersect(Target, Range("Mitarbeiter[X]")) Is Nothing Then

     If UCase(Target.Text) = "X" Then

        Application.EnableEvents = False

          Target.Offset(, 1).Value = Date

        Application.EnableEvents = True

        With Target.ListObject

          indx = Target.Row - .HeaderRowRange.Row

          shName = .ListRows(indx).Range(.ListColumns("ISIN/WPK").Index).Text

          On Local Error Resume Next

          Set sh = Worksheets(shName)

          If Err > 0 Then

              Set sh = Worksheets.Add(After:=Worksheets(Worksheets.Count))

              .HeaderRowRange.Copy sh.Cells(POSHEADLINE, 1)

              sh.Name = shName

              lrow = POSHEADLINE + 1

              On Error GoTo 0

          Else

              lrow = sh.Cells(POSHEADLINE, 1).End(xlDown).Row

              If lrow = POSHEADLINE Or (lrow = POSHEADLINE And sh.Cells(POSHEADLINE, 1) = "") Then

                 .HeaderRowRange.Copy sh.Cells(POSHEADLINE, 1)

                 lrow = POSHEADLINE + 1

               Else

                 lrow = lrow + 1

               End If

          End If

          

          .ListRows(indx).Range.Copy

          sh.Cells(lrow, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

           Application.EnableEvents = False

          .ListRows(indx).Delete

          Application.EnableEvents = True

        End With

         Set sh = Nothing

     End If

  End If

  

End Sub


Anzeige
VBA? wenn?
18.08.2023 14:27:48
Peter
Habe Dein Code in die Datei copiert.

Mit dem Erfolg, das sie auch nicht richtig geht.
Was mache ich den nur immer kaputt.
Ich verstehe ja das Du die S....... voll hast, ich aber auch so langsam.
Wenn Du nicht mehr antworten möchtest, ist das oK.

Anbei habe ich die kaputte Mappe nochmal hochgeladen.

Der Grund ist: WAS MACHE ICH DENN DA KAPUTT????????
Das würde ich gern zum abschluss wissen. Danke

Ich habe ein neues Tab erstellt mit dem Namen "LU12345"
Mein Weg: ich gebe in D8 z.B. die "LU12345" ein, gehe auf L8 gebe das große X ein, was passiert jetzt!

Er löscht im Blatt die Zeile 8, aber schreibt nichts in das Tab "LU12345"

Ist das Tab "UL12345" nicht vorhanden, so erstellt er dies, und fügt dies dort ein.



https://www.herber.de/bbs/user/162376.xlsm
Anzeige
AW: VBA? wenn?
18.08.2023 17:49:15
ralf_b
Man sollte Code ,der für eine Beispieldatei gemacht wird nicht in eine "echte" Datei kopieren und glauben das er dort genauso funktioniert.
VBA ist maßgeschneidert. Nichts desto trotz habe ich ihn nochmal umgebaut, da ich auch ein kleines Brett vorm Kopf hatte.
Hier ein angepasster Code. 
              

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim indx&, lrow&, shName$, sh As Worksheet



  If Not Intersect(Target, Range("Mitarbeiter[X]")) Is Nothing Then

     If UCase(Target.Text) = "X" Then

        Application.EnableEvents = False

          Target.Offset(, 1).Value = Date

        Application.EnableEvents = True

        With Target.ListObject

          indx = Target.Row - .HeaderRowRange.Row

          shName = .ListRows(indx).Range(.ListColumns("ISIN/WPK").Index).Text

          On Local Error Resume Next

          Set sh = Worksheets(shName)

          If Err > 0 Then

              Set sh = Worksheets.Add(After:=Worksheets(Worksheets.Count))

              .HeaderRowRange.Copy sh.Cells(1, 1)

              sh.Name = shName

              lrow = 2

              On Error GoTo 0

          Else

              lrow = sh.Cells(Rows.Count, 1).End(xlUp).Row

              If lrow = 1 Then

                 If sh.Cells(1, 1) = "" Then .HeaderRowRange.Copy sh.Cells(1, 1)

                 lrow = 2

              End If

          End If

         

          .ListRows(indx).Range.Copy

          sh.Cells(lrow, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

           Application.EnableEvents = False

          .ListRows(indx).Delete

          Application.EnableEvents = True

        End With

         Set sh = Nothing

     End If

  End If

  

End Sub
Anzeige
VBA? wenn?
18.08.2023 18:42:07
Peter
Danke

Hast Du das wirklich einmal durchgespielt?

Jetzt kopiert er das alles, aber in die falsche Zelle???????????????????


A10 sollte doch der Anfang stehen.
AW: VBA? wenn?
18.08.2023 22:37:19
ralf_b
so jetzt aber. hab den Code kommentiert. Nun kannst du den selbst reparieren. 



Private Sub Worksheet_Change(ByVal Target As Range)

  Dim indx&, lrow&, shName$, sh As Worksheet

  



  If Not Intersect(Target, Range("Mitarbeiter[X]")) Is Nothing Then

     If UCase(Target.Text) = "X" Then 'egal ob groß oder klein "x"

        

        Application.EnableEvents = False

          Target.Offset(, 1).Value = Date 'datum eintragen

        Application.EnableEvents = True

        

        With Target.ListObject

         'zeilennr innerhalb intelligenter Tabelle ermitteln

          indx = Target.Row - .HeaderRowRange.Row

          'blattnamen ermitteln

          shName = .ListRows(indx).Range(.ListColumns("ISIN/WPK").Index).Text

          

          On Local Error Resume Next

          'herausfinden ob Batt existiert, wenn nicht dann Fehler

          Set sh = Worksheets(shName)

          If Err > 0 Then

             'wenn Fehler neues Blatt

              Set sh = Worksheets.Add(After:=Worksheets(Worksheets.Count))

              .HeaderRowRange.Copy sh.Cells(1, 1) 'Kopfzeile kopieren

              sh.Name = shName 'blatt umbenennen

              lrow = 2 ' Zeilenr festlegen

              On Error GoTo 0

          Else

             'wenn blatt existiert, letzte belegte zeile ermitteln

              lrow = sh.Cells(Rows.Count, 1).End(xlUp).Row

              

              If lrow = 1 Then  'wenn ergebnis 1

                 'wenn A1 leer, dann Kopfzeile kopieren

                 If sh.Cells(1, 1) = "" Then .HeaderRowRange.Copy sh.Cells(1, 1)

                 'nächste Zeile festlegen

                 lrow = 2

              Else

                ' wenn Ergebnis größer 1 dann nur hochzählen

                 lrow = lrow + 1

              End If

          End If

          

          'Zeile kopieren

          .ListRows(indx).Range.Copy

          'Zeile einfügen

          sh.Cells(lrow, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

           

           Application.EnableEvents = False

          'Zeile löschen

          .ListRows(indx).Delete

          Application.EnableEvents = True

        End With

         Set sh = Nothing

     End If

  End If

  

End Sub
Anzeige
VBA? wenn?
19.08.2023 14:41:48
Peter
Danke dafür, reparieren muss man ihn nicht.

Wenn das Tabellenblatt vorhanden ist, kopiert er es auch richtig in Zelle A10 mit Überschrift. Korrekt.
Wenn das Tabelenblatt nicht vorhanden ist, und er es neu erstellt, schreibt er es in A1. Hier sollte er es auch in A10 schreiben.

Ich bekomme es nicht gebacken.
Vielleicht hast Du noch den Nerv das zu koregieren.

Danke

AW: VBA? wenn?
19.08.2023 16:42:07
ralf_b
Wenn ich die Kommentare im Code lese, dann sehe ich bei welcher Codestelle ein neues Blatt erstellt wird und auf welchen Wert die Zeilennummer (lrow) zum Einfügen der Daten gesetzt wird. Und zwar nachdem die Kopfzeile in Zeile 1 kopiert wurde.
Deine aktuelle Schilderung passt nicht zum Code, den ich dir als Letztes geschickt habe.
Ich mach hier keinen Finger mehr krumm. Ein bisschen Mitdenken und Eigenbemühungen sollten schon von Dir kommen.

Links zu Excel-Dialogen

Frame

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige