Excel VBA - Werte aus Zelle auflisten
Hallo liebes Forum,
ich hab folgende Aufgabenstellung und komm nicht weiter:
Es gibt mehrere Tabellenblätter mit den "Namen" der Kalenderwoche (KW11, KW12, KW13, usw.) und ein Tabellenblatt Übersicht.
Für den Bereich C2:E2 im Tabellenblatt Übersicht wurde der Name Kategorien definiert - das sind Spaltenüberschriften/Kategorien (zB. AH, SB, etc.).
Wenn in den "KW-Tabellenblättern" eine Eingabe in Spalte C erfolgt und in der gleichen Zeile in Spalte B eine Kategorie (zB. SB) steht, soll geprüft werden ob der soeben eingegebene Wert im Blatt Übersicht in der jeweiligen Kategorie/Spalte bereits vorhanden ist.
Es steht zB. im Blatt KW11 in Zelle C29 46,47 oder 46, 47 - das sind jeweils Seitennummern eines Buches.
Wird jetzt im Blatt KW12 in irgendeiner Zelle in Spalte C (zB. C18) ein bereits vorhandener Wert (47) eingegeben soll eine Msg Box erscheinen. Ist der Wert nicht vorhanden, soll der neue Wert ins Blatt Übersicht in die Spalte mit der Spaltenüberschrift aus der Zelle B18 in die nächste freie Zeile geschrieben werden.
Zum besseren Verständnis hab ich Screenshots gemacht.
Vielen Dank für Eure Unterstützung.
LG Manrique
ich hab folgende Aufgabenstellung und komm nicht weiter:
Es gibt mehrere Tabellenblätter mit den "Namen" der Kalenderwoche (KW11, KW12, KW13, usw.) und ein Tabellenblatt Übersicht.
Für den Bereich C2:E2 im Tabellenblatt Übersicht wurde der Name Kategorien definiert - das sind Spaltenüberschriften/Kategorien (zB. AH, SB, etc.).
Wenn in den "KW-Tabellenblättern" eine Eingabe in Spalte C erfolgt und in der gleichen Zeile in Spalte B eine Kategorie (zB. SB) steht, soll geprüft werden ob der soeben eingegebene Wert im Blatt Übersicht in der jeweiligen Kategorie/Spalte bereits vorhanden ist.
Es steht zB. im Blatt KW11 in Zelle C29 46,47 oder 46, 47 - das sind jeweils Seitennummern eines Buches.
Wird jetzt im Blatt KW12 in irgendeiner Zelle in Spalte C (zB. C18) ein bereits vorhandener Wert (47) eingegeben soll eine Msg Box erscheinen. Ist der Wert nicht vorhanden, soll der neue Wert ins Blatt Übersicht in die Spalte mit der Spaltenüberschrift aus der Zelle B18 in die nächste freie Zeile geschrieben werden.
Zum besseren Verständnis hab ich Screenshots gemacht.
Vielen Dank für Eure Unterstützung.
LG Manrique
Please also mark the comments that contributed to the solution of the article
Content-ID: 14270853383
Url: https://administrator.de/contentid/14270853383
Printed on: October 7, 2024 at 01:10 o'clock
14 Comments
Latest comment
Servus @Manrique,
Nach deiner Beschreibung erledigt dies der folgende VBA-Code.
Füge ihn in den VBA Code-Abschnitt "DieseArbeitsmappe" ein - das ist wichtig damit das Event auch in den KW-Worksheets automatisch anspringt sobald man etwas in Spalte C ändert (Der Code darf nicht manuell gestartet werden, er läuft automatisch).
Grüße Uwe
Nach deiner Beschreibung erledigt dies der folgende VBA-Code.
Füge ihn in den VBA Code-Abschnitt "DieseArbeitsmappe" ein - das ist wichtig damit das Event auch in den KW-Worksheets automatisch anspringt sobald man etwas in Spalte C ändert (Der Code darf nicht manuell gestartet werden, er läuft automatisch).
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
' Variablen definieren
Dim value As String, category As String, val As Variant, wsOverview As Worksheet, catRange As Range
' Wenn Sheet ein KW Sheet ist und eine Änderung in Spalte C vorgenommen wird
If Left(Sh.Name, 2) = "KW" And Not Intersect(Target, Sh.Range("C:C")) Is Nothing Then
' Übersichtssheet festlegen
Set wsOverview = Sheets("Übersicht")
' Wert der Eingetragen wird
value = Target.Cells(1).value
' Kategorie der Eintragung
category = Target.Cells(1).Offset(0, -1).value
' Wenn sowohl Wert als auch Kategorie nicht leer sind ...
If category <> "" And value <> "" Then
' Durchlaufe alle eingetragenen Werte (auch mehrere getrennt anhand von Kommas)
For Each val In Split(value, ",", -1, 1)
With wsOverview
' find die passende Kategoriespalte im benannten Bereich "Kategorien" in der Übersicht
Set catRange = .Range("Kategorien").Find(category, LookIn:=xlValues, LookAt:=xlWhole)
' wenn es die Kategorie gibt
If Not catRange Is Nothing Then
' Suche den eingetragenen Wert in der Kategorie-Spalte
If Not catRange.EntireColumn.Find(Trim(val), LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
' zeige eine Meldung das der Wert bereits vorhanden ist
MsgBox "Eingetragener Wert '" & Trim(val) & "' ist bereits in der Kategorie '" & category & "' vorhanden!", vbExclamation
Else
' Wert ist noch nicht vorhanden, also hänge ihn ans Ende der Kategorie in der Übersicht
.Cells(Rows.Count, catRange.Column).End(xlUp).Offset(1, 0).value = Trim(val)
End If
End If
End With
Next
End If
End If
End Sub
Ja, das Trennzeichen kannst du ja selbst festlegen in Zeile 15.
Sind Leerzeichen (zB.: 46, 47 oder 46 , 47) ein Problem?
Nein, das wurde bereits beachtet Leerzeichen werden automatisch entfernt.
Kann ich hier nicht bestätigen, dann sind da evt. Leerzeichen bei dir im Übersichtssheet im Wert.
- MSGBox aber bleibt jetzt im "KW-Blatt". Es soll aber der Inhalt vor der neuen Eintragung drinnen bleiben.
Den Satz kann ich leider nicht interpretieren.Zitat von @Manrique:
ok. im sheet KW11 C29 steht bei mir 46, 47
Jetzt gebe ich im sheet KW12 in C15 den Wert 47 ein. Es erscheint die MSgBox, aber der Wert 47 steht jetzt auch im Sheet KW12 Zelle C15. Da sollte aber 47 nicht drinstehen (weil schon vorhanden), sondern der Wert vor Eingabe - zB. 34; 39; 41
ok. im sheet KW11 C29 steht bei mir 46, 47
Jetzt gebe ich im sheet KW12 in C15 den Wert 47 ein. Es erscheint die MSgBox, aber der Wert 47 steht jetzt auch im Sheet KW12 Zelle C15. Da sollte aber 47 nicht drinstehen (weil schon vorhanden), sondern der Wert vor Eingabe - zB. 34; 39; 41
Das stand ja auch nicht in der Anforderung in deinem Ausgangspost. Dort stand
soll geprüft werden ob der soeben eingegebene Wert im Blatt Übersicht in der jeweiligen Kategorie/Spalte bereits vorhanden ist.
Wenn du bereits vorhandene Werte auf den KW-Sheets in der Übersicht eintragen willst musst du sie entweder einmalig selbst im Übersichts-Sheet eintragen oder einmalig mittels Schleife alle KW Sheets durchlaufen. Das kannst du hiermit machenSub AddUsedValuesToOverview()
' Variablen
Dim ws As Worksheet, cell As Range, value As String, category As String, val As Variant, wsOverview As Worksheet, catRange As Range
' Übersichtssheet festlegen
Set wsOverview = Sheets("Übersicht")
For Each ws In Worksheets
If Left(ws.Name, 2) = "KW" Then
For Each cell In ws.Range(ws.Range("C1"), ws.Cells(Rows.Count, "C").End(xlUp))
' Wert der Eingetragen wird
value = cell.value
' Kategorie der Eintragung
category = cell.Offset(0, -1).value
If category <> "" And value <> "" Then
' Durchlaufe Array-Werte (getrennt anhand von Kommas oder Semikolons)
For Each val In Split(Replace(value, ";", ",", 1, -1, 1), ",", -1, 1)
With wsOverview
' find die passende Kategoriespalte im benannten Bereich "Kategorien" in der Übersicht
Set catRange = .Range("Kategorien").Find(category, LookIn:=xlValues, LookAt:=xlWhole)
' wenn es die Kategorie gibt
If Not catRange Is Nothing Then
' Suche den eingetragenen Wert in der Kategorie-Spalte
If catRange.EntireColumn.Find(Trim(val), LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
' Wert ist noch nicht vorhanden, also hänge ihn ans Ende der Kategorie in der Übersicht
.Cells(Rows.Count, catRange.Column).End(xlUp).Offset(1, 0).value = Trim(val)
End If
End If
End With
Next
End If
Next
End If
Next
End Sub
Fehlermeldung wenn ich das so mache...
For Each val In Split(value, ";", ",", -1, 1)
wie muss ich das anpassen?
Wenn sowohl Semikolon als auch Komma als Separator fungieren sollen dann folgendermaßenFor Each val In Split(value, ";", ",", -1, 1)
wie muss ich das anpassen?
' Durchlaufe Array-Werte (getrennt anhand von Kommas oder Semikolons)
For Each val In Split(Replace(value, ";", ",", 1, -1, 1), ",", -1, 1)
So damit solltest du jetzt anhand der Kommentare auch selbst weiterarbeiten können.
Wenns das dann war, den Beitrag bitte noch auf gelöst setzen. Merci.
Public lastValue As Variant
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
' Variablen definieren
Dim value As String, category As String, val As Variant, wsOverview As Worksheet, catRange As Range, regex As Object
' Wenn Sheet ein KW Sheet ist und eine Änderung in Spalte C vorgenommen wird
If Left(Sh.Name, 2) = "KW" And Not Intersect(Target, Sh.Range("C:C")) Is Nothing Then
' Übersichtssheet festlegen
Set wsOverview = Sheets("Übersicht")
' Wert der eingetragen wird
value = Replace(Mid(Target.Cells(1).value, Len(lastValue) + 1), " ", "", 1, -1, 1)
' Kategorie der Eintragung
category = Target.Cells(1).Offset(0, -1).value
' Wenn sowohl Wert als auch Kategorie nicht leer sind ...
If category <> "" And value <> "" Then
' Durchlaufe Array-Werte (getrennt anhand von Kommas oder Semikolons)
For Each val In Split(Replace(value, ";", ",", 1, -1, 1), ",", -1, 1)
If val <> "" then
With wsOverview
' find die passende Kategoriespalte im benannten Bereich "Kategorien" in der Übersicht
Set catRange = .Range("Kategorien").Find(category, LookIn:=xlValues, LookAt:=xlWhole)
' wenn es die Kategorie gibt
If Not catRange Is Nothing Then
' Suche den eingetragenen Wert in der Kategorie-Spalte
If Not catRange.EntireColumn.Find(Trim(val), LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
' zeige eine Meldung das der Wert bereits vorhanden ist
MsgBox "Eingetragener Wert '" & Trim(val) & "' ist bereits in der Kategorie '" & category & "' vorhanden!", vbExclamation
' Wert der Zelle auf Ursprungswert zurücksetzen
Application.EnableEvents = False
Target.Cells(1).value = lastValue
Application.EnableEvents = True
Else
' Wert ist noch nicht vorhanden, also hänge ihn ans Ende der Kategorie in der Übersicht
.Cells(Rows.Count, catRange.Column).End(xlUp).Offset(1, 0).value = Trim(val)
End If
End If
End With
End If
Next
End If
End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
lastValue = Target.Cells(1).value
End Sub
Bitteschön, schönes Wochenende.
Grüße Uwe