Benötigte Hilfe bei Programmierung mit VBA

Sehr geehrte Community,
mein Name ist Bejamin u. in Sachen VBA bin ich ein absoluter Anfänger. Gestern habe ich bereits 15 Stunden Tutorials u. Lösungsansätze ausprobiert mit ehr bescheidenem Erfolg, da die Umsetzung meiner Wünsche mit VBA "mit meinem Kenntisstand" zu Komplex ist, als dass ich diese Problem alleine bewältigen kann.
Hoffe daher auf tatkräftige Unterstützung.
Folgende Ziele will ich erreichen:
1. Steuerelement einfügen (1. Tabelle "Übersicht"), welches automatisch Tabellenblätter gem. den Listeneinträgen B4:B102 übernimmt.
1.1 Zusätzlich sollen die Tabellenblätter gem. Tabelle 2 (Vorlage) geschaffen werden und einen Hyperlink besitzen, welcher es ermöglicht von Tabelle 1 (Übersicht) auf die jeweilligen Tabellenblätter zu switchen sowie umgekehrter Reihenfolge.
Anmerkung zu 1. u. 1.1: Ein solcher Makrobefehl ist bereits in der angehängten Datei sauber definiert. Das Problem was sich jetzt für mich stellt ist folgendes:
Wenn sich an den Listeneinträgen in Spalte (AB:B102)der Name bzw. Eintrag ändert, will ich, dass dieser automatisch in dem bereits dafür angelegtem Tabellenblatt umbenannt wird. Der Makrobefehl der in der Datei angegeben ist, überschreibt lediglich die Tabellenblätter, da diese jedoch "befüllt werden" sollen, will ich nicht, dass diese überschrieben werden.
2. Kann man eine Sammelerfassung in Excel einrichten (Tabelle 1 "Übersicht"), "mit Datum" welche folgende Kritierien erfüllt.
2.1 Selektierung von Listeneinträgen (A4:A102)-ähnlich wie Filterfunktion-
"Auswahl erfolgt manuel". Diese Möglichkeit muss 8mal vorhanden sein. Dabei muss
ich jedem dieser 8 Möglichkeiten einen festen Wert z.B. 15 , 20, 12 o.ä. sowie
ein Ereignis zuordnen können.
2.2 Das ganze muss dann im Hintergrund durch Excel in die selektierten Listeneinträge (B4:B102)in die dazugehörigen Tabellenblätter geschrieben werden
2.3 Wie das ganze nachher im Tabellblatt des jeweiligen Listeneintrags "optisch"
aussieht ist egal, es kommt nur darauf an, dass gem. meinem Vordruck alles addiert
wird u. am Ende eine Zahl ausgespuckt wird (SUMME).
2.4 Diese (SUMME) will ich dann zusätzlich abändern können indem ich manuel Zahlen
im Tabellenblatt addiere bzw. subtrahiere. Am Ende soll die "FINALE SUMME" dann
automatisch in Tabelle 1 (Übersicht) übertragen werden.
3. Am Ende soll es natürlich auch Möglich sein, ein Tabellenblatt nebst dazugehörigem Listeneintrag "inhaltlich zu löschen". Die Funktion sollen dabei erhalten bleiben (ClearContens).
3.1 Eine solche Funktion würde vermutlich funktionieren, wenn man direkt nach dem Wert aus dem Listeneintrag B4:B102 z.B. "PersonXY" sucht u. dann den Befehl durchführen lässt.
PS anbei eine Datei, die ggf. Grafisch darstellt wie ich es mir vorstelle (Sammelerfassung kann ich leider nicht darstellen).
VIELEN DANK
https://www.herber.de/bbs/user/92409.xlsm (Upload meiner Datei)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Benjamin,
wie von yummi bereits angesprochen ist es etwas tricky alle Aktionne sauber zu erfassen, wenn man in Spalte B der Übersicht einen Namen einträgt oder entfernt.
1. Ein Name bzw. die Formel wird gelöscht
2. Ein Name/die Formel wird überschrieben
3. Ein Name wird in eine vorher leere Zelle eingetragen
Ich hab das jetzt mal versucht mit Ereignismakros umzusetzen, die auf die Selektion/Änderung von Zellen in Spalte B der Übersicht reagieren.
Probiere es mal aus.
Zusätzlich musst du das Makro "Sheet_Exist" im Modul "Player_Sheet" von Private in Public ändern, da ich es mitbenutze.
Bei deiner Sammelerfassung blcke ich noch nicht ganz durch.
2.1 D.h. in der Übersicht fügst du 8 weitere Spalten ein in denen für jeden Namen bestimmte Spalte(n) ausgefüllt werden.
2.2 "im Hintergrund" ist immer so eine Sache
Da müssen die Randbedingungen und das auslösende Ereignis(Schaltflächen-Klick, Zellwertänderungen etc) genau definiert sein.
2.3 Die Optik (Formatierung) mag ja egal sein,
aber es muss klar definiert werden welche Informationen sollen wo hergeholt werden und wo eingetragen werden. Sollen Altdaten jedes mal gelöscht werden oder die Daten unten in der Liste ergänzt werden?
2.4 Die Teilergebnisse und das Gesamtergebnis werden in den Namens-Blättern ja schon ermittelt.
Das Ergebnis in Zelle G1000 der Blätter kann man mit der Funktion INDIREKT in der Übersicht per Formel berechnen/Übernehmen.
Zelle N4: =INDIREKT("'"&B4&"'!G1000")
3 / 3.1 Löschen von Daten
Etwas anderer Weg: Wähle in der Übersicht eine Zelle in der Zeile mit dem Namen aus, dessen Daten gelöscht werden sollen. Dann Makro per Schaltfläche starten dass Makro liest den Namen aus der Zeile und nach Bestätigung des Namens werden die Datenbereiche in dem Blatt gelöscht.
Gruß
Franz

'Code unter dem Modul von Tabellenblatt "Übersicht"
Private bolLink As Boolean, strSheet As String 'Merker für Daten in angeklickter Zelle
Private Sub Worksheet_Activate()
Call Worksheet_SelectionChange(Target:=Selection)
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wksName As Worksheet
If Target.Column = 2 And Target.Cells.Count = 1 And Target.Row > 3 Then
If bolLink = False Then
If Target.Value = "" Then
'do nothing
Else
If Sheet_Exist(Target.Text) Then
MsgBox "Es existiert bereits ein Blatt zum Namen """ & Target.Text _
& """ - Doppelvergabe nicht möglich!"
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
Target.Select
Else
Call subMakeNewSheet(strNewName:=Target.Text)
'und Hyperlink ins Übersichtsblatt schreiben
Application.EnableEvents = False
Target.FormulaLocal = "=HYPERLINK(""#'" & Target.Text _
& "'!b1"";""" & Target.Text & """)"
'Formel in Spalte N
Me.Cells(Target.Row, 14).FormulaR1C1 = "=INDIRECT(""'"" & R[0]C2 & ""'!G1000"")"
Application.EnableEvents = True
Me.Activate
End If
End If
Else
If Target.Value = "" Then
If MsgBox("Soll der vorhandene Name """ & strSheet & """ gelöscht werden?", _
vbQuestion + vbOKCancel, "Name Löschen") = vbOK Then
Application.DisplayAlerts = False
Sheets(strSheet).Delete
Application.DisplayAlerts = True
Me.Cells(Target.Row, 14).ClearContents
Else
Application.EnableEvents = False
Target.FormulaLocal = "=HYPERLINK(""#'" & strSheet _
& "'!b1"";""" & strSheet & """)"
Application.EnableEvents = True
End If
Else
If MsgBox("Soll der vorhanden Name """ & strSheet & """ umbenannt werden in """ _
& Target.Text & """?", vbQuestion + vbOKCancel, "Name ändern") = vbOK Then
If Sheet_Exist(Target.Text) Then
MsgBox "Es existiert bereitsein Blatt zum Namen """ & Target.Text _
& """ - Doppelvergabe nicht möglich!"
Application.EnableEvents = False
Target.FormulaLocal = "=HYPERLINK(""#'" & strSheet _
& "'!b1"";""" & strSheet & """)"
Application.EnableEvents = True
Else
Set wksName = Worksheets(strSheet)
With wksName
.Name = Target.Text
.Range("A1").Value = Target.Text
End With
Application.EnableEvents = False
Target.FormulaLocal = "=HYPERLINK(""#'" & Target.Text _
& "'!b1"";""" & Target.Text & """)"
Application.EnableEvents = True
End If
Else
Application.EnableEvents = False
Target.FormulaLocal = "=HYPERLINK(""#'" & strSheet _
& "'!b1"";""" & strSheet & """)"
Application.EnableEvents = True
End If
End If
End If
Call Worksheet_SelectionChange(Target:=ActiveCell)
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 2 And Target.Cells.Count = 1 And Target.Row > 3 Then
If Target.HasFormula Then
bolLink = True
strSheet = Target.Text
Else
bolLink = False
strSheet = ""
End If
Else
bolLink = False
strSheet = ""
End If
End Sub
Public Sub subMakeNewSheet(strNewName As String)
Application.EnableEvents = False
Sheets("Vorlage").Copy After:=Sheets(1) 'Sheet Vorlage kopieren und einfügen
ActiveSheet.Name = strNewName 'umbenennen
'Hyperlink zum Übersichtsblatt erstellen
strFormel = "=HYPERLINK(" & Chr(34) & "#Übersicht!b1" & Chr(34) & ";" & Chr(34) & _
"zurück zur Übersicht" & Chr(34) & ")"
Sheets(strNewName).Cells(1, "b").FormulaLocal = strFormel ' und Hyperlink in Zelle  _
schreiben
Sheets(strNewName).Cells(1, "a").Value = strNewSheet 'Eigenen Tabellenblattnamen in Zelle  _
schreiben
Application.EnableEvents = True
End Sub

Franz

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel _ As Boolean) Select Case Sh.Name Case "Übersicht" If Target.Column = 2 Then If Target.Row > 3 Then If Target.Value <> "" Then Cancel = True On Error Resume Next Sheets(Target.Value).Select If Err <> 0 Then On Error GoTo 0 Select Case MsgBox("Für den Namen """ & Target.Value & """ gibt es kein _ Blatt." & vbLf & "Neu anlegen?", vbYesNo + vbQuestion) Case vbNo Case vbYes Sheets("Vorlage").Copy After:=Sheets(Sheets.Count) ActiveSheet.Name = Target.Text Target.Offset(0, 12).FormulaR1C1 = "=INDIREKT(""'"" & RC2 & _ "" '!G1000"")" End Select Else On Error GoTo 0 End If End If End If End If Case Else If Target.Value = "zurück zur Übersicht" Then Sheets("Übersicht").Select Cancel = True End If End Select End Sub

Beliebteste Forumthreads (12 Monate)

Benötigte Hilfe bei Programmierung mit VBA

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread