Problem mit Intersect in Tabellenblättern in Array
18.10.2016 23:24:24
Volker
Ich versuche derzeit, ein Problem in u.a. Code-Ausschnitt zu lösen. In einem Array (arrTab) sind Tabellenblätter gespeichert, in die jeweils identische Eintragungen erfolgen. Diese Tabellenblätter repräsentieren Kalenderwochen von jeweils Mo - Sa. Den Wochentagen sind Zellbereiche zugeordnet. Bei entsprehendem Eintrag gibt "Tag" den Wochentag und "Datum" das in entsprechender Zelle hinterlegte zugehörige Datum zurück. Dies funktioniert auch alles sehr gut. Meine Absicht ist hier, von den in den Blättern des Arrays "arrTab" vorhandenen Eintragungen das jeweilige Datum auszulesen und diese Daten wiederum in einem Array (hier arrProtokoll) zu speichern.
Debug.Print gibt mir zwar korrespondierend zu "arrTab" die korrekte Anzahl der Elemente von "arrProtokoll" aus, jedoch bei allen das gleiche Datum, nämlich jenes des Eintrags im ersten Blatt. Es steht dann dort z.B. 5x 02.08.2016 und nicht 02.08., 09.08., 16.08., 23.08. & 30.08.2016.
Ich habe leider noch keine Idee, wie ich die Intersect-Prüfung adaptieren muss, um jedes Datum aufgelistet zu bekommen und hoffe, es gibt hier freundlicherweise hilfreiche Hinweise.
Viele Grüße
Volker
Dim arrProtokoll()
ReDim arrProtokoll(0)
For j = 0 To (LBound(arrTab) + (v - 1))
If Not Intersect(Cells(lngzeA, lngsp), Range("C6:K49")) Is Nothing Then
Tag = "Montag, "
Datum = Range("G5")
End If
If Not Intersect(Cells(lngzeA, lngsp), Range("C51:K94")) Is Nothing Then
Tag = "Dienstag, "
Datum = Range("G50")
End If
If Not Intersect(Cells(lngzeA, lngsp), Range("C96:K139")) Is Nothing Then
Tag = "Mittwoch, "
Datum = Range("G95")
End If
If Not Intersect(Cells(lngzeA, lngsp), Range("C141:K184")) Is Nothing Then
Tag = "Donnerstag, "
Datum = Range("G140")
End If
If Not Intersect(Cells(lngzeA, lngsp), Range("C186:K229")) Is Nothing Then
Tag = "Freitag, "
Datum = Range("G185")
End If
If Not Intersect(Cells(lngzeA, lngsp), Range("C231:K274")) Is Nothing Then
Tag = "Samstag, "
Datum = Range("G230")
End If
ReDim Preserve arrProtokoll(UBound(arrProtokoll) + 1)
arrProtokoll(UBound(arrProtokoll)) = Datum
Next j
Debug.Print "(Protokoll)" & Join(arrProtokoll(), vbCr)