Autor
|
Thema: Excel VBA Zeile unter aktueller Auswahl einfügen und Inhalt von drüber kopieren (9472 / mal gelesen)
|
daniel.düsentrieb Mitglied
Beiträge: 30 Registriert: 04.07.2013
|
erstellt am: 08. Nov. 2017 23:25 <-- editieren / zitieren --> Unities abgeben:
Hallo, würde gerne innerhalb einer komplexeren Excel Tabelle durch doppelklick auf eine bestimmte Stelle darunter eine Zeile einfügen und den Inhalt aus der aktuellen Zeile in die neue Zeile kopieren, so wie man es mit Zeile markieren, kopieren, drunter markieren, Inhalt einfügen, machen kann. Leider gibt es weiter rechts in der Tabelle eine Zelle die über mehrere Zeilen verbunden ist, daher habe ich etwas Schwierigkeiten damit. Excel VBA scheint nicht in der Lage zu sein, genau diese Selection in VBA auszuführen, sondern übernimmt immer einen deutlich größeren Bereich, weil es die verbundenen Zellen nicht auseinander reißen möchte. Ich habe viel probiert - z. B. Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Cells(Target.Row + 1, Target.Column).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Cells(Target.Row, Target.Column).EntireRow.Copy Destination:=Range(Cells(Target + 1, 1)) End Sub Wäre für einen entscheidenen Hinweis dankbar. Hier (http://www.herber.de/forum/archiv/1288to1292/1289049_VBA_Zeileselect_trotz_verbundener_Zellen.html) wird das Problem ähnlich beschrieben und gezeigt, dass man per select eben nicht zum Ziel kommt. Das macht leider auch das debuggen ziemlich schwierig, weil ich nicht per select testen kann, was er genau macht. Grüße Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Grebe Mitglied
Beiträge: 536 Registriert: 16.12.2002 LT-2021, Civil3D-2021, BricsCAD V18 HP-DesignJet T1200
|
erstellt am: 09. Nov. 2017 08:46 <-- editieren / zitieren --> Unities abgeben: Nur für daniel.düsentrieb
|
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2624 Registriert: 02.05.2006 Office 2010; Office365 Visual Basic
|
erstellt am: 10. Nov. 2017 16:55 <-- editieren / zitieren --> Unities abgeben: Nur für daniel.düsentrieb
So etwa? Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Rows(Target.Row).Copy Rows(Target.Row + 1).Insert Shift:=xlDown Application.CutCopyMode = False Cells(Target.Row + 1, Target.Column).Select End Sub
Wobei hier die komplette Zeile mit Formatierung eingefügt wird und nicht nur der Inhalt. Aber das hattest Du in Deinem Programmversuch ja auch so vorgesehen (CopyOrigin:=xlFormatFromLeftOrAbove). Grüße Klaus [Diese Nachricht wurde von KlaK am 10. Nov. 2017 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
daniel.düsentrieb Mitglied
Beiträge: 30 Registriert: 04.07.2013
|
erstellt am: 16. Nov. 2017 15:34 <-- editieren / zitieren --> Unities abgeben:
Hi, das ist sehr cool und funktioniert für das Zeileneinfügen genau, wie es soll, leider werden die Formeln nicht nach unten weiter geführt. Sicher fehlt mir da nur eine Kleinigkeit, oder? Insgesamt möchte ich das hier: Code: Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim msg As String Dim title As String msg = "Ja=Einfügen, Nein=Zeile löschen" ' Define message. Style = 547 title = "Zeile einfügen" ' Define title. ' Display message. response = MsgBox(msg, Style, title) zeile = Target.Row spalte = Target.Column Select Case response Case 2 ' Cancel Cells(zeile - 1, spalte).Select Case 6 ' Ja - also: Zeile einfügen Rows(Target.Row).Copy Rows(Target.Row + 1).Insert Shift = xlDown Application.CutCopyMode = False Cells(Target.Row, Target.Column).Select Case 7 'Nein - also: Zeile löschen Rows(Target.Row).Delete Shift:=xlUp Cells(zeile - 1, spalte).Select End Select SendKeys "{ENTER}", True ' damit die Zeile nicht mehr editiert wird End Sub
Nur möchte ich eben, dass eine Formel nicht dumm nach unten kopiert wird, sondern entsprechend der Bezug auch eine Zeile nach unten geht Grüße [Diese Nachricht wurde von daniel.düsentrieb am 16. Nov. 2017 editiert.] [Diese Nachricht wurde von daniel.düsentrieb am 16. Nov. 2017 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
daniel.düsentrieb Mitglied
Beiträge: 30 Registriert: 04.07.2013 Dell Precision 5550 Intel(R) i7-10850H - 32GB RAM - Nvidia Quadro T2000 Creo Parametric 4.0 - M100
|
erstellt am: 16. Nov. 2017 15:53 <-- editieren / zitieren --> Unities abgeben:
Also beispielsweise habe ich: Zeile 1: 1 Zeile 2: A1+1 Zeile 2: A2+1 Wenn ich jetzt in der Zweiten Zeile eine Zeile einfüge, bekomme ich: Zeile 1: 1 Zeile 2: A1+1 Zeile 3: A2+1 Zeile 4: A2+1 Ich hätte aber gerne: Zeile 1: 1 Zeile 2: A1+1 Zeile 3: A2+1 Zeile 4: A3+1
Grüße Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2624 Registriert: 02.05.2006 Office 2010; Office365 Visual Basic
|
erstellt am: 16. Nov. 2017 16:52 <-- editieren / zitieren --> Unities abgeben: Nur für daniel.düsentrieb
Hallo Daniel, Das wird nicht Zeilenweise gehen, Excel bringt ja selbst bei manueller Formel-Formatübertragung bei verbundenen Zellen einen Fehler. D.h. man müßte alle Einzelzellen untersuchen und dort wo keine verbundenen Zellen sind das Format die Formel von oben übernehmen. Ohne verbundene Zellen wäre der Ansatz:
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Rows(Target.Row).Copy Rows(Target.Row + 1).Insert Shift:=xlDown Rows(Target.Row + 2).PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Cells(Target.Row + 2, Target.Column).Select End Sub
Aber vielleicht hat jemand anderes noch eine bessere Idee ... Grüße Klaus [edit] Test verbundene Zellen:
Code: Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim lS As Long, Test As Range Dim sCol As Integer Rows(Target.Row).Copy Rows(Target.Row + 1).Insert Shift:=xlDown' ohne verbundene Zellen ' Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False ' mit verbundenen Zellen lS = Cells(Target.Row+2, 512).End(xlToLeft).Column For sCol = 1 To lS Set Test = Cells(Target.Row + 2, sCol) If Test.Address = Test.MergeArea.Address Then 'ist das überhaupt eine Formel? If Left(Test.Formula, 1) = "=" Then Cells(Target.Row, sCol).Copy Cells(Target.Row + 2, sCol).PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False End If End If Next sCol Application.CutCopyMode = False Cells(Target.Row + 2, Target.Column).Select End Sub
[Diese Nachricht wurde von KlaK am 16. Nov. 2017 editiert.] [Edit 2] Hier muß natürlich die Formel und nicht das Format übertragen werden ... [Diese Nachricht wurde von KlaK am 17. Nov. 2017 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|