Hallo Karl-Heinz,
das ist ein klassischer Fall für die Union-Funktion. Das Address-Argument vom Range-Objekt ist historisch bedingt auf 255 Zeichen beschränkt. Mit Union kannst du aber mehrere Range-Objekte kombinieren und die Eigenschaft nur einmal ansprechen. Viel sparst du dabei leider nicht ein, aber es wird übersichtlicher:
Sub Blockwerte()
With Worksheets("1")
Union(.Range("P19:P38, P41:P50, P52, R19:R21, R27:R30, R32:R35, R37, R41:R50, R52, U19:U21, U23:U24, U29:U30, U35, U41:U48"), _
.Range("P266:P268, P271:P273, P276:P278, P281:P286, P288:P291, P292:P293, R266:R268, R271:R273, R276:R278, R281:R286, R288:R291, U266:U268, U271:U273, U276:U278, U281:U286, U288:U291"), _
.Range("P296:P298, P301:P303, P306:P308, P311:P316, P318:P321, P322:P323, R296:R298, R301:R303, R306:R308, R311:R316, R318:R321, U296:U298, U301:U303, U306:U308, U311:U316, U318:U321"), _
.Range("P326:P328, P331:P333, P336:P338, P341:P346, P348:P351, P352:P353, R326:R328, R331:R333, R336:R338, R341:R346, R348:R351, U326:U328, U331:U333, U336:U338, U341:U346, U348:U351"), _
.Range("P356:P358, P361:P363, P366:P368, P371:P376, P378:P381, P382:P383, R356:R358, R361:R363, R366:R368, R371:R376, R378:R381, U356:U358, U361:U363, U366:U368, U371:U376, U378:U381"), _
.Range("P386:P388, P391:P393, P396:P398, P401:P406, P408:P411, P412:P413, R386:R388, R391:R393, R396:R398, R401:R406, R408:R411, U386:U388, U391:U393, U396:U398, U401:U406, U408:U411")).Value = 15001
End With
End Sub
Wenn es eine gewisse Logik gibt, kann man das Ganze auch in Schleife aufbauen. Bei dir sind ab Zeile 266 eindeutig 5 gleich aufgebaute Großblocks von jeweils 30 Zeilen zu erkennen. Damit ließe sich das Ganze auch wie folgt darstellen:
Sub Blockwerte2()
Dim Rng As Range
wdhP = Array(3, 3, 3, 6, 6) ' Anzahl der Einträge in Spalte P pro Großblock
leerP = Array(2, 2, 2, 1, 2) ' Anzahl Leerzellen nach den jeweiligen Einträgen
wdhR = Array(3, 3, 3, 6, 4) ' Anzahl der Einträge in Spalte R pro Großblock
leerR = Array(2, 2, 2, 1, 4) ' Anzahl Leerzellen nach den jeweiligen Einträgen
wdhU = Array(3, 3, 3, 6, 4) ' Anzahl der Einträge in Spalte R pro Großblock
leerU = Array(2, 2, 2, 1, 4) ' Anzahl Leerzellen nach den jeweiligen Einträgen
blocks = 5 'Anzahl der sich wiederholenden Groß-Blocks
begin = 266 'erste Zeile des ersten Groß-Blocks
'Fehlermeldung wenn Anzahl nicht synchron
If UBound(wdhP) <> UBound(leerP) Or UBound(wdhR) <> UBound(leerR) Or UBound(wdhU) <> UBound(leerU) Then
Err.Raise 999, , "Die Arrays wdh und leer einer Spalte müssen die gleiche Anzahl an Argumenten enthalten."
End If
'Schleife zum Aufbau der Großblocks
With Worksheets("1")
Set Rng = .Range("P19:P38, P41:P50, P52, R19:R21, R27:R30, R32:R35, R37, R41:R50, R52, U19:U21, U23:U24, U29:U30, U35, U41:U48")
For blk = 1 To blocks
For p = 0 To UBound(wdhP)
Set Rng = Union(Rng, .Range("P" & begin + ps & ":P" & begin + ps + wdhP(p) - 1))
ps = ps + wdhP(p) + leerP(p)
Next p
For r = 0 To UBound(wdhR)
Set Rng = Union(Rng, .Range("R" & begin + rs & ":R" & begin + rs + wdhR(r) - 1))
rs = rs + wdhR(r) + leerR(r)
Next r
For u = 0 To UBound(wdhU)
Set Rng = Union(Rng, .Range("U" & begin + us & ":U" & begin + us + wdhU(u) - 1))
us = us + wdhU(u) + leerU(u)
Next u
Next blk
End With
'Zurückgegebenes Range-Objekt
Rng.Value = 15001
End Sub
Sieht auf den ersten Blick vielleicht etwas sehr umständlich aus. Aber wenn du genauer hinsiehst, kannst du dir damit viel Arbeit ersparen, wenn du einfach die Arrays pro Großblock mit der gewünschten Anzahl auszufüllender Zeilen füllst. Im gezeigten Makro habe ich dein Beispiel einfach mal nachgebaut.
Vielleicht konnte ich dir damit ein bisschen helfen?
Viele Grüße
Mr. K.
|