VBA Range definieren

Hallo liebe Exelaner
ich hab mal wieder eine kleine Frage, bei der ich einen denkanstoß benötige
Ich habe eine Tabelle
In Spalte A sind in unterschiedlichen Abständen Werte
zb. A2 = 100 und A40 = 150 und A42 = 60
In Spalte B sind in ANDEREN Abständen Werte
zb. B5= 3 und B6 = 9 und B33 = 19 und B41 = 10
Nun möchte ich Bereiche Bilden In Spalte A Range1 wäre A2:A40
und Quasi in diesem Bereich nur in Spalte B alle dazwischenbefindlichen Werte summieren
Fall Range 1 ( B3 + B6 + B33)
Range 2 wäre dann A40:A42
und zu Summieren wäre dann (B41)
Dies Bereiche sollten im optimalfall auch im "Speicher" bleiben und für spätere operationen zur Verfügung stehen. Wobei das nicht zwingend ist.
Thanks in advance

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Jack,
anbei eine VBA-Variante, ich weiß ja nicht, wie die Ausgabe aussehen soll.
Sub summieren()
  Dim rng As Range, rngC As Range, rngSum() As Range
  Dim lngIndex As Long, lngFirst As Long, lngLast As Long
  Dim bolFirst As Boolean

  Redim rngSum(0)

  With ActiveSheet
    On Error Resume Next
    Set rng = .Columns(1).SpecialCells(xlCellTypeConstants, xlNumbers)
    On Error GoTo 0
    bolFirst = True
    If Not rng Is Nothing Then
      For Each rngC In rng.Cells
        If bolFirst Then
          lngFirst = rngC.Row
          bolFirst = Not bolFirst
        Else
          lngLast = rngC.Row
          Redim Preserve rngSum(lngIndex)
          Set rngSum(lngIndex) = .Range(.Cells(lngFirst, 2), .Cells(lngLast, 2))
          lngIndex = lngIndex + 1
          lngFirst = lngLast
        End If
      Next
    End If
  End With

  For lngIndex = 0 To UBound(rngSum)
    MsgBox "Bereich:" & vbTab & vbTab & rngSum(lngIndex).Address & vbLf & _
      "Summe:" & vbTab & vbTab & Application.Sum(rngSum(lngIndex)) & vbLf & _
      "Anzahl Zahlen:" & vbTab & Application.Count(rngSum(lngIndex)) & vbLf & _
      "Mittelwert:" & vbTab & Format(Application.Average(rngSum(lngIndex)), "0.000") & vbLf & _
      "Minimum:" & vbTab & Application.Min(rngSum(lngIndex)) & vbLf & _
      "Maximum:" & vbTab & Application.Max(rngSum(lngIndex))
  Next

  Set rng = Nothing
  Set rngC = Nothing
End Sub

« Gruß Sepp »

Sub test() Dim i As Integer Dim a As Long Dim Wert As Long Dim Anfang As Long Dim ende As Long Anfang = 2 ende = 40 For i = Anfang To ende If Cells(i, 1) = "" Then Wert = Cells(i, 2) a = Wert + a End If Cells(1, 3) = a Next End Sub

Option Explicit Public pSums Sub b() Dim rngConstA As Range, rngBlanksA As Range, i As Integer Set rngConstA = Columns(1).SpecialCells(xlCellTypeConstants) Set rngBlanksA = Range(rngConstA.Areas(1), rngConstA.Areas(rngConstA.Areas.Count)).SpecialCells( _ xlCellTypeBlanks) ReDim pSums(1 To rngBlanksA.Areas.Count) For i = 1 To UBound(pSums) pSums(i) = Application.Sum(rngBlanksA.Areas(i).Offset(, 1)) Next Set rngConstA = Nothing: rngBlanksA = Nothing End Sub Sub test() Dim i As Integer For i = 1 To UBound(pSums) MsgBox pSums(i) Next End Sub

Beliebteste Forumthreads (12 Monate)

	A	B	C	D	E
1
2	100				31
3		3			10
4					6
5
6		9
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33		19
34
35
36
37
38
39
40	150
41		10
42	60
43		3
44		3
45	14
46
47
48
49
50
51
52
53

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

323 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

	A	B	C	D	E
1
2	100				31
3		3			10
4					6
5
6		9
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33		19
34
35
36
37
38
39
40	150
41		10
42	60
43		3
44		3
45	14
46
47
48
49
50
51
52
53

	A	B	C	D	E
1
2	100				31
3		3			10
4					6
5
6		9
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33		19
34
35
36
37
38
39
40	150
41		10
42	60
43		3
44		3
45	14
46
47
48
49
50
51
52
53

VBA Range definieren

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

323 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

	A	B	C	D	E
1
2	100				31
3		3			10
4					6
5
6		9
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33		19
34
35
36
37
38
39
40	150
41		10
42	60
43		3
44		3
45	14
46
47
48
49
50
51
52
53