VBA - Zelle per Mausklick markieren und per Button-Klick übertragen

[poshmit]

Guten Tag vereehrte Community,

ich bin ein VBA-Laie, wage mich aber auf den Weg ein VBA-Experte zu werden. Elementare Kenntnisse über Makros sind vorhanden, mehr aber auch nicht. Leider konnte ich im Internet kein ähnliches Beispiel zu meinem Vorhaben finden, somit habe ich im Moment keine Grundlage an der ich mich lang hangeln kann. Vielleicht kann mich einer der Experten hier im Forum kurz an die Hand nehmen. ;)

Folgender Sachverhalt:

Angehängte Arbeitsmappe besteht aus zwei Worksheets:  
  ernährungsplan.xlsx (Größe: 32,78 KB / Downloads: 7)

• Nahrungsmittel (Wird im Moment noch manuell gefüttert. Geplant ist später ein Formular, aber nicht Thema meines Anliegens)
  
• Übersicht (Hier befindet sich links eine Pivottabelle mit Datenschnitt und auf der rechten Seite eine Tabelle, die per Makro gefüttert werden soll. Hier kommt das Thema)
  

Mein Anliegen:

Durch die Vorselektierung (Pivottabelle) möchte ich das Nahrungsmittel, welches gegessen wurde, per Maus auswählen und dann per Button in die rechte Tabelle übertragen. Hierbei soll nicht nur das Nahrungsmittel, sondern auch die dazugehörigen Werte (ID, g/ml pro portion, kcal, Eiweiß, etc.) übertragen werden. Der "Anteil Portion" ist manuell zu pflegen, da nur ein Multiplikator.

Meine Fragen:

• Wie kann ein möglicher Code dafür aussehen?
  
• Was ist schlanker? Alle Daten per Makro zu übertragen oder nur die ID und den Rest per SVERWEIS?
  

Vielen Dank für Eure Mühe im Voraus
Dimi

[GMG-CC]

1. Es geht mit minimalen Einschränkungen auch ohne VBA (und ich bin bekennender VBA-Fan)
2. Schau die mal den allerobersten Eintag  (Crossposting) an
3. Und genau das 2. ist auch der Grund, warum ich dir weder hier noch im Nachbarforum antworte.

Günther

[schauan]

Hallo Dimi,

im Hinweis zum Crossposting steht, dass Du in Deinen Beiträgen in den verschiedenen Foren darauf hinweisen sollst.

Da ich z.B. nur selten in anderen Foren antworte und auch nicht weiß und nicht suchen werde, wo das "Nachbarforum" ist, habe ich keine Kennung, ob das Thema dort schon ansatzweise oder sogar ganz gelöst wurde.

Wenn wir wüssten, wie der Stand ist, würde hier bei Notwendigkeit bestimmt jemand weitermachen.

[shift-del]

Hallo André

habe ich keine Kennung, ob das Thema dort schon ansatzweise oder sogar ganz gelöst wurde.

Zumindest hier ist es nicht gelöst:
http://www.office-fragen.de/index.php/to...739.0.html

[schauan]

Hallöchen,

mit dem Crossposting sehen wir es hier nicht so eng wie in anderen Foren, aber es ist natürlich nicht gerade schön, wenn Du mitten in der Diskussion, kurz nach einer Antwort, das Forum wechselst. Ich halte Dir jetzt zugute, dass Du in beiden Foren Neuling bist und Dich mit den Gepflogenheiten nicht so auskennst. Ansonsten würde ich in diesem Fall wohl auch nicht antworten ...

Da auf der anderen Seite nur über Pivot diskutiert wird, gehe ich hier auf die Sache mit dem VBA ein. Man könnte das auch einfach per Doppelklick realisieren, code kommt in das Modul des Arbeitsblattes:

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cells(ActiveCell.Row, 2).Copy
Cells(Cells(Rows.Count, 14).End(xlUp).End(xlUp).Row + 1, 14).PasteSpecial Paste:=xlValues
End Sub

Ich hab das hier nur für die ID (Spalte 14) geschrieben. Kann man natürlich für die anderen Spalten erweitern und wäre so besser als mit SVERWEIS.

Der code fügt allerdings keine neuen Zeilen in die Tabelle ein und deine Überschrift wäre "gegessen" , wenn die Tabelle voll ist.

[Kuwer]

Hallo Dimi,

das mit dem Doppelklick habe ich mal für die Pivottabelle im Tabellenblatt "Übersicht" geschrieben.
Es reicht ein Doppelklick in irgend eine Zelle der Pivottabelle.
Formeln werden hierbei nicht benötigt, da alle Werte direkt übertragen werden.
Folgender Code kommt in das schon bestehende VBA-Modul des Tabellenblattes "Übersicht":

' **************************************************************
'  Modul:  Tabelle1  Typ = Element der Mappe(Sheet, Workbook, ...)
' **************************************************************

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 Dim oPT As PivotTable
 Dim rngQ As Range, rngZ As Range
 Cancel = True
 Set oPT = Me.PivotTables("PivotTable1")
 If Not Application.Intersect(Target, oPT.TableRange2) Is Nothing Then
   If Application.Intersect(Target, oPT.TableRange2.Rows(1)) Is Nothing Then
     Set rngQ = Application.Intersect(Target.EntireRow, oPT.TableRange2)
     With Me.Range("tbl_gegessen").Columns(1)
       If Application.CountBlank(.Cells) Then
         Set rngZ = .SpecialCells(xlCellTypeBlanks).Rows(1).Resize(1, 9)
         rngZ.Cells(1, 1).Value = rngQ.Cells(1, 2).Value
         rngZ.Cells(1, 2).Value = InputBox(Prompt:="Anteil Portion:", Title:=rngQ.Cells(1, 1).Value)
         rngZ.Cells(1, 3).Value = rngQ.Cells(1, 3).Value
         rngZ.Cells(1, 4).Value = rngQ.Cells(1, 1).Value
         rngZ.Cells(1, 5).Value = rngQ.Cells(1, 4).Value
         rngZ.Cells(1, 6).Value = rngQ.Cells(1, 5).Value
         rngZ.Cells(1, 7).Value = rngQ.Cells(1, 6).Value
         rngZ.Cells(1, 8).Value = rngQ.Cells(1, 7).Value
         rngZ.Cells(1, 9).Value = rngQ.Cells(1, 8).Value
       Else
         MsgBox "Tabelle gegessen ist voll!", vbInformation
       End If
     End With
   End If
 End If
End Sub

Gruß Uwe