469 Aufrufe
Gefragt in Tabellenkalkulation von addeguddi Mitglied (886 Punkte)
Hallo und ein frohes neues Jahr

Bevor ich mein Problem erläutere möchte ich nur mitteilen, dass ich vorher nachgeschaut habe ob eine Lösung für meine Frage vorhanden ist. Aber nichts gefunden Daher stelle ich die Frage

Habe wieder eine Frage:

Ich weiß nicht wie das erweitert werden kann.

Folgendes: Bei Doppelklick in einer von Zelle a4 bis Zelle c24, egal welche ich Anklicke, soll der Wert bei dem 1ten Doppelklick in die Zelle E4 übernommen werden, beim 2ten Klick, in eine dieser Zelle von a2 bis c22 und so weiter soll dann in Zelle F4 den Wert des 2ten Klicks übernehmens.

Dies soll bis Zelle AB4 gehen das ist die Zeile 4. Danach soll das automatisch in Zeile 5 von Zelle E5 bis Zelle AB21 weitergehen. AB ist die letzte Zelle.

Hoffe, mir kann jemand helfen.

Habe etwas gemacht aber das klappt nur von Spalte A4 bis A25 und überschriebt mir nach jedem Klick den vorher eingegebenen Wert in Zelle E4. Sowie ich in Zelle B4 oder C20 Klicke passiert nichts.

Beispiel: Klick auf A6 der Wert davon ist 3, danach auf A18 Wert 18 Zielzelle E4 erst die 3 wird überschrieben dann 18.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Target.Row > 1 Then

        If Target.Column = 1 Then

            If Not IsEmpty(Target.Value) Then _

                Cells(4, 5).Value = Target.Value

            Cancel = True

        End If

    End If

End Sub

Für eine Lösung wäre ich sehr Dankbar

Gruß Adde

19 Antworten

+1 Punkt
Beantwortet von m-o Profi (16.3k Punkte)

Hallo Adde,

ich hoffe, ich habe dich richtig verstanden. Probier mal das folgende Makro aus, das in das VBA-Projekt der betreffenden Tabelle kopiert werden muss:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
Dim lngZeile As Long
Dim lngSpalte As Long

'Einfügezeile festlegen, 1 niedriger, da in Schleife erhöht wird
lngZeile = 3
 
'Nur bei Klick in Bareich A4 bis C24 das Makro ausführen
If Not Intersect(Target, Range("A4:C24")) Is Nothing Then

   'freie Spalte und Einfügezeile ermitteln
   Do Until lngSpalte > 0 And lngSpalte < 28
       'Einfügezeile wird um 1 erhöht
       lngZeile = lngZeile + 1
       'letzte beschriebene Spalte ermitteln
        lngSpalte = ActiveSheet.Cells(lngZeile, Columns.Count).End(xlToLeft).Column
    Loop
    
    If lngSpalte < 5 Then                     'falls erste leere Spalte kleiner 5
      lngSpalte = 5                            'dann Einfügespalte auf 5 (Spalte E) festlegen
     Else
       lngSpalte = lngSpalte + 1               'sonst Einfügespalte erhöhen
    End If
      
    Cells(lngZeile, lngSpalte) = Target.Value   'Wert der mit Doppelklick ausgewählten Zelle in Zielzelle schreiben
    Cancel = True                                'Doppelklick abbrechen
    
End If

End Sub

Gruß

M.O.

0 Punkte
Beantwortet von addeguddi Mitglied (886 Punkte)
Hallo M.O.

vielen lieben Dank. Klappt super und genau wie ich es mir vorgestellt habe.

Noch eine Frage:

Kann ich ich diese Makro in eine Tabelle einfügen in dem so ein ähnliches Makro vorhanden ist.

Hat die gleiche Überschrift:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

in diesem Makro ist alles enthalten bis auf die einzelnen Punkte.

Nochmals vielen Dank
+1 Punkt
Beantwortet von m-o Profi (16.3k Punkte)
Hallo Adde,

nein, das geht nicht. Man müsste die beiden Makros zusammenfassen.

Gruß

M.O.
0 Punkte
Beantwortet von addeguddi Mitglied (886 Punkte)

Hallo M. O.

nur kurz eine Frage wenn ich die Eingabe 

'Einfügezeile festlegen, 1 niedriger, da in Schleife erhöht wird
lngZeile = 3 habe die Zahl 3 auf 7 ändere müsste dies doch auch funktionieren, oder?
Habe es probiert doch er schreibt das Ergebnis in Zeile 18.
Oder muss ich noch einen Eintrag ändern?
Ich wäre dir Dankbar wenn du mir antworten würdest.


Danke
Gruß Adde
+1 Punkt
Beantwortet von m-o Profi (16.3k Punkte)
Hallo Adde,

du kannst die Zahl auf 7 erhöhen, damit der erste Wert in die Zeile 8 übernommen wird.

In der folgenden Schleife wird u.a. geprüft, ob in der Zelle AB der betreffenden Zeile (am Anfang also Zeile 8) etwas steht und falls das so ist, wird die Einfügezeile um 1 erhöht.

Wenn bei dir der Wert erst ab Zeile 18 eingefügt wird, dann schau mal nach, ob etwas in der Spalte AB der vorherigen Zeilen steht.

Gruß

M.O.
0 Punkte
Beantwortet von addeguddi Mitglied (886 Punkte)
Hallo und einen schönen guten Morgen,

Danke für deine Antwort.

Ja in A und B bis G sind Werte vorhanden. Habe dann geschaut wo die Einträge stattfinden. Wenn leer wird ab dieser Zeile der Wert eingetragen. Jetzt verstehe ich es. Es bedeutet diese Spalten dürfen nicht belegt sein. Schade. So hätte ich den besseren Überblick. bei den Eintragungen oder kann man das umgehen?.

Gruß Adde
+1 Punkt
Beantwortet von m-o Profi (16.3k Punkte)
Hallo Adde,

eigentlich sollte ab Spalte E die nächste leere Spalte (bis Spalte AB) gefunden werden.

Lade doch mal deine Datei hoch, damit ich mir das mal ansehen kann.

Gruß

M.O.
0 Punkte
Beantwortet von addeguddi Mitglied (886 Punkte)
Hallo M.O.

Habe den Fehler gefunden. Habe die Datei geschlossen,. dann hat die neue Eingabe beim öffnen gegriffen. Das war es.

Vielen Dank nochmals.

Gruß Adde
0 Punkte
Beantwortet von addeguddi Mitglied (886 Punkte)
Hallo M.O.

würdest du mir nochmals bitte helfen? Habe meine Tabelle die ich irgendwann in 2018 erstellt hatte, etwas verändert und wollte das Makro zu dieser Tabelle passt anpassen. Sitze seit gestern Nachmittag bis jetzt ohne Schlafen und tüftle wie ich das Makro was du mir vor langer Zeit einmal erstellt hast, zu ändern kriege nur Fehlermeldungen. In diesem Makro gibt er die Anzahl der Würfe und das Ergebnis erscheint dann in der Zelle wo es hin soll usw. Vielleicht liegt es an meinem Alter, dass ich das nicht verstehe; oder ??? Ergebnis wird nicht in der vorgesehene Zelle übernommen Möchte es gerne so wie s war und von dem letzen Makro, das die Punktzahl für jeden Wurf in die dafür vorgesehenen Zellen eingebunden werden.

Wenn du mir helfen könntest, würde ich die neue Tabelle hochladen:

Würde mich freuen wenn du mir helfen würdest. Ich geh jetzt einmal kurz schlafen.

Gruß Adde

https://filehorst.de/d/dqyziHgj
+1 Punkt
Beantwortet von m-o Profi (16.3k Punkte)
Hallo Adde,

ich schaue mir das mal an.

Gruß

M.O.
...