AW: Summewenns UDF über mehrere Tabellenblätter
04.11.2018 18:19:16
Toni
Hallo Rob,
:)
*stolz bis über beide Ohren mit Grüßen an alle Eichhörnchen da draußen:
Sub Summieren()
Dim ws, wsÜbersicht As Worksheet
Dim arrWerteU, arrWerteA, arrWerteT, arrWerteF, arrWerteG, arrWerteH, arrWerteS, arrWerteR, _
_
arrWerteY, arrWerteL, arrWerteM
Dim x, y As Integer
Set wsÜbersicht = Sheets(1)
ReDim arrSumme(20, 139)
arrWerteU = Sheets("U").Range("G7:EO26").Value
arrWerteA = Sheets("A").Range("G7:EO26").Value
arrWerteT = Sheets("T").Range("G7:EO26").Value
arrWerteF = Sheets("F").Range("G7:EO26").Value
arrWerteG = Sheets("G").Range("G7:EO26").Value
arrWerteH = Sheets("H").Range("G7:EO26").Value
arrWerteS = Sheets("S").Range("G7:EO26").Value
arrWerteR = Sheets("R").Range("G7:EO26").Value
arrWerteY = Sheets("Y").Range("G7:EO26").Value
arrWerteL = Sheets("L").Range("G7:EO26").Value
arrWerteM = Sheets("M").Range("G7:EO26").Value
For x = LBound(arrWerteU, 1) To UBound(arrWerteU, 1)
For y = LBound(arrWerteU, 2) To UBound(arrWerteU, 2)
arrWerteU(x, y) = arrWerteU(x, y) + arrWerteA(x, y) + arrWerteT(x, y) + arrWerteF(x, _
y) _
+ arrWerteG(x, y) + arrWerteH(x, y) + arrWerteS(x, y) + arrWerteR(x, y) + arrWerteY( _
x, y) _
+ arrWerteL(x, y) + arrWerteM(x, y)
Next
Next
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Range("A1:EI20") = arrWerteU
End Sub
Sub Übertragen()
Dim r, kumRange As Range, g As Variant, f As Date, b As Long, h As Long, j As Long, _
krummRange As Range
Sheets(1).Range("B7:H26").ClearContents
f = Sheets(2).Range("G1").Value
g = Weekday(CDate(f), vbMonday)
b = 2 + g - 1
h = Sheets(1).Range("B5")
If h = 1 Then
Select Case g
Case Is = 1
Set kumRange = Sheets(Sheets.Count).Range("A1:G20")
Case Is = 2
Set kumRange = Sheets(Sheets.Count).Range("A1:F20")
Case Is = 3
Set kumRange = Sheets(Sheets.Count).Range("A1:E20")
Case Is = 4
Set kumRange = Sheets(Sheets.Count).Range("A1:D20")
Case Is = 5
Set kumRange = Sheets(Sheets.Count).Range("A1:C20")
Case Is = 6
Set kumRange = Sheets(Sheets.Count).Range("A1:B20")
Case Is = 7
Set kumRange = Sheets(Sheets.Count).Range("A1:A20")
End Select
MsgBox b
Sheets(1).Cells(7, b).Activate
For Each r In kumRange
Continue:
If ActiveCell.Interior.Color = RGB(255, 255, 0) Then
ActiveCell = r
ActiveCell.Offset(0, 1).Activate
Else
Range(ActiveCell.Address).Offset(1, -7 + b - 2).Activate
If ActiveCell.Row = 27 Then: Exit Sub
GoTo Continue
End If
Next
Else
j = 8 - g + 7 * (h - 2)
Set kumRange = Sheets(Sheets.Count).Range("A1:G20").Offset(0, j)
Sheets(1).Cells(7, 2).Activate
For Each r In kumRange
Continue2:
If ActiveCell.Interior.Color = RGB(255, 255, 0) Then
ActiveCell = r
ActiveCell.Offset(0, 1).Activate
Else
Range(ActiveCell.Address).Offset(1, -7).Activate
If ActiveCell.Row = 27 Then: Exit Sub
GoTo Continue2
End If
Next
End If
End Sub
Kannst Du mir bitte noch kurz erklären, was im 'Summieren' die 2 in der Variablen y bedeutet? Mit 1 funktionierts ja auch mit 0 oder 3 schon wieder nicht mehr - habe keine so richtige Erklärung gefunden ...
Danke für Deine Hilfe heute morgen und liebe Grüße, Toni