Wenn Spalte Wert enthält dann...

Hallo,
ich habe in einer Tabelle3 (Arbeitsmappe im Anhang) in der in der Zeile 2 von Spalte Q bis AB Monate stehen 01-12, in C1 wird immer der aktuelle Monat eingetragen. Alle Werte die in Zeile 2 jetzt kleiner (links von dem Wert der auch in C1 steht)sind, sollen in den folgenden Zeilen(4 und) Werte aus Tabelle 1 eingetragen Werden. Ab der Spalte wo der Monatswert gleich dem Wert in C1 ist, sollen dann Werte aus Tabelle 2 in der richtigen spalte eingetragen werden, wie kann ich das erreichen?
Es muss dynamisch sein, da sich der Wert in C1 jeden Monat ändert.
Da es noch mehrere anderen Aktion gibt muss es in VBA gelöst werden. Leider fehlt mir grade komplett der Ansatz.
Danke
https://www.herber.de/bbs/user/153783.xlsm

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) Const APPNAME = "Worksheet_Change" On Error GoTo Fehler Dim LR As Integer, i As Integer, Z1 As Integer Dim SpZ As Integer, Sp1 As Integer, SpN As Integer Dim Tb1 As Worksheet, Tb2 As Worksheet, Monat As Integer, Zeile As Integer If Not Intersect(Target, Range("C1")) Is Nothing Then Monat = Range("C1") SpZ = 17 'Zieldaten ab Q Set Tb1 = Sheets("Tabelle1") Set Tb2 = Sheets("Tabelle2") Z1 = 4 'erste Datenzeile in Tab3 Sp1 = 7 'Quelldaten ab Spalte G SpN = 5 'Namensspalte E in Tab 1+2 LR = Cells(Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte For i = Z1 To LR 'prüfen ob Name in TB1 vorhanden If WorksheetFunction.CountIf(Tb1.Columns(SpN), Cells(i, 1)) > 0 Then 'in welcher Zeile Zeile = WorksheetFunction.Match(Cells(i, 1), Tb1.Columns(SpN), 0) Application.EnableEvents = False If Monat > 1 Then 'nur ab Monat 02 Cells(i, SpZ).Resize(1, Monat - 1).Value = Tb1.Cells(Zeile, Sp1).Resize(1, Monat - 1).Value End If Else MsgBox Cells(i, 1) & ": in " & Tb1.Name & " nicht gefunden" Exit Sub End If 'prüfen ob Name in TB2 vorhanden If WorksheetFunction.CountIf(Tb2.Columns(SpN), Cells(i, 1)) > 0 Then 'in welcher Zeile Zeile = WorksheetFunction.Match(Cells(i, 1), Tb2.Columns(SpN), 0) Application.EnableEvents = False Cells(i, SpZ).Offset(0, Monat - 1).Resize(1, 13 - Monat).Value = _ Tb2.Cells(Zeile, Sp1).Offset(0, Monat - 1).Resize(1, 13 - Monat).Value Else MsgBox Cells(i, 1) & ": in " & Tb2.Name & " nicht gefunden" Exit Sub End If Next End If '*** Fehlerbehandlung Err.Clear Fehler: Application.EnableEvents = True If Err.Number 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _ & "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear End Sub

Hallo
Der Schutz ist aber nur wirksam, wenn das BLATT geschützt ist.
Dazu müssen erstmal die Zellen, die bearbeitet werden dürfen entsperrt werden (auch C1 und Spalte A etc.)
- Zelle markieren
- Rechtsclick
- Zellen formatieren
- Bei Schutz dann den Haken bei "Gesperrt" rausnehmen
Das Sperren / Entsperren der Monatbereiche habe ich dann im Makro eingebaut.


Private Sub Worksheet_Change(ByVal Target As Range)
Const APPNAME = "Worksheet_Change"
On Error GoTo Fehler
Dim LR As Integer, i As Integer, Z1 As Integer
Dim SpZ As Integer, Sp1 As Integer, SpN As Integer
Dim Tb1 As Worksheet, Tb2 As Worksheet, Monat As Integer, Zeile As Integer
If Not Intersect(Target, Range("C1")) Is Nothing Then
Monat = Range("C1")
SpZ = 17 'Zieldaten ab Q
Set Tb1 = Sheets("Tabelle1")
Set Tb2 = Sheets("Tabelle2")
Z1 = 4 'erste Datenzeile in Tab3
Sp1 = 7 'Quelldaten ab Spalte G
SpN = 5 'Namensspalte E in Tab 1+2
LR = Cells(Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte
'Sperrung aufheben
ActiveSheet.Unprotect 'DeinPasswort
For i = Z1 To LR
'prüfen ob Name in TB1 vorhanden
If WorksheetFunction.CountIf(Tb1.Columns(SpN), Cells(i, 1)) > 0 Then
'in welcher Zeile
Zeile = WorksheetFunction.Match(Cells(i, 1), Tb1.Columns(SpN), 0)
Application.EnableEvents = False
If Monat > 1 Then 'nur ab Monat 02
With Cells(i, SpZ).Resize(1, Monat - 1)
.Value = Tb1.Cells(Zeile, Sp1).Resize(1, Monat - 1).Value
.Locked = True
End With
End If
Else
MsgBox Cells(i, 1) & ": in " & Tb1.Name & " nicht gefunden"
Exit Sub
End If
'prüfen ob Name in TB2 vorhanden
If WorksheetFunction.CountIf(Tb2.Columns(SpN), Cells(i, 1)) > 0 Then
'in welcher Zeile
Zeile = WorksheetFunction.Match(Cells(i, 1), Tb2.Columns(SpN), 0)
Application.EnableEvents = False
With Cells(i, SpZ).Offset(0, Monat - 1).Resize(1, 13 - Monat)
.Value = Tb2.Cells(Zeile, Sp1).Offset(0, Monat - 1).Resize(1, 13 - Monat).Value
.Locked = False
End With
Else
MsgBox Cells(i, 1) & ": in " & Tb2.Name & " nicht gefunden"
Exit Sub
End If
Next
'Sperren
ActiveSheet.Protect 'DeinPasswort
End If
'*** Fehlerbehandlung
Err.Clear
Fehler:
Application.EnableEvents = True
If Err.Number  0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _
& "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub

LG UweD

Beliebteste Forumthreads (12 Monate)

Wenn Spalte Wert enthält dann...

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

338 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Wenn Spalte Wert enthält dann...

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

338 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread