Hallo Tina,
wenn schon neuer Beitrag, dann verweise doch bitte auf den alten:
/t/neu-innerhalb-einer-zeile-filtern-array/4705388
sonst weiß doch keiner um was es geht.
Was muss ich tun, damit er eine Gültigkeitsprüfung macht, ob
in der 1.Spalte der Quartalsübersicht auch das richtige
Projekt stehen hat? Oder dass er beim Befüllen der
Quartalsübersicht immer diese 2 Zeilen ignoriert??
Die Datei: http://www.hostarea.de/server-07/Juli-700f145732.xls hat nachfolgenden Code. Beacht daß es sich auf Quartalsübersicht3 bezieht, das eine andere Struktur hat.
Wieviele Zeilen oberhalb der Jahreszeile sind ist egal. Der Code sucht in A nach „Projekt1“, von dieser zeile zieht er 2 ab und sucht das Jahr in der so ermittelten Zeile.
Mit der prozedur "breite kannst du bequem die Breiten der beiden Spalten pro Quartal festlegen/abändern. Kommawerte mit Punkt eingeben.
Auch das mit dem Sonderzeichen ist eingebaut. Für ein anderes Zeichen bei ChrW(9836) eine andere Zahl eingeben oder ChrW(9836) durch „#“ erstzen.
Gruß
Reinhard
Option Explicit
Option Base 1
'
Sub Quart()
Dim wksM As Worksheet, ZeiM As Long, SpaM As Long, SpaQ As Long, ZeiQ As Long
Dim ZeiP As Long, Awf As WorksheetFunction
Set wksM = Worksheets("Master")
Set Awf = Application.WorksheetFunction
With Worksheets("Quartalsübersicht3")
ZeiP = Awf.Match("Projekt1", .Columns(1))
.Range("B" & ZeiP & ":BK30").ClearContents
For SpaM = 6 To 18 Step 3
For ZeiM = 3 To wksM.Cells(Rows.Count, SpaM).End(xlUp).Row
ZeiQ = Awf.Match(CStr(Replace(wksM.Cells(ZeiM, 3), "c", "k")), .Columns(1), 0)
SpaQ = Awf.Match(Year(wksM.Cells(ZeiM, SpaM)), .Rows(ZeiP - 2), 0)
SpaQ = SpaQ + (Quartal(wksM.Cells(ZeiM, SpaM)) - 1) \* 2
If .Cells(ZeiQ, SpaQ + 1) "" Then .Cells(ZeiQ, SpaQ + 1) = .Cells(ZeiQ, SpaQ + 1) & ","
.Cells(ZeiQ, SpaQ) = ChrW(9836)
.Cells(ZeiQ, SpaQ + 1) = .Cells(ZeiQ, SpaQ + 1) & wksM.Cells(ZeiM, SpaM + 2)
Next ZeiM
Next SpaM
End With
End Sub
'
Function Quartal(ByVal Datum As Date) As Byte
Quartal = Int((Month(Datum) - 1) / 3) + 1
End Function
'
Function SName(ByVal sp As Integer) As String
SName = Split(Cells(1, sp).Address, "$")(1)
End Function
'
Sub Breite()
Dim Spa As Long
For Spa = 2 To 40 Step 2
Worksheets("Quartalsübersicht3").Cells(1, Spa).ColumnWidth = 2
Worksheets("Quartalsübersicht3").Cells(1, Spa + 1).ColumnWidth = 4.9
Next Spa
End Sub