Excel 2007 | ||||
---|---|---|---|---|
A | B | |||
1 | 1 | |||
2 | 1 | |||
3 | 1 | |||
4 | 2 | |||
5 | 2 | |||
6 | 2 | |||
7 | 3 | |||
8 | 3 | |||
9 | 3 | |||
10 | ||||
Sheet1 |
Excel 2007 | ||||
---|---|---|---|---|
A | B | |||
1 | 1 | |||
2 | 1 | |||
3 | 1 | 3 | ||
4 | 2 | |||
5 | 2 | |||
6 | 2 | 6 | ||
7 | 3 | |||
8 | 3 | |||
9 | 3 | 9 | ||
10 | ||||
Sheet1 |
Option Explicit
Sub SumGroups()
' hiker95, 02/19/2014, ME758867
Dim r As Long, lr As Long, n As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = 1 To lr
n = Application.CountIf(Columns(1), Cells(r, 1).Value)
If n = 1 Then
Cells(r, 2) = Cells(r, 1)
ElseIf n > 1 Then
Cells(r + n - 1, 2).Value = Evaluate("=Sum(A" & r & ":A" & r + n - 1 & ")")
End If
r = r + n - 1
Next r
Application.ScreenUpdating = True
End Sub
Excel 2007 | ||||
---|---|---|---|---|
A | B | |||
1 | No. | |||
2 | 1 | |||
3 | 2 | |||
4 | 3 | |||
5 | 4 | |||
6 | 5 | |||
7 | 6 | |||
8 | 7 | |||
9 | 8 | |||
10 | 9 | |||
11 | 10 | |||
12 | 11 | |||
13 | 12 | |||
14 | 13 | |||
15 | 14 | |||
16 | 15 | |||
17 | ||||
18 | ||||
19 | ||||
20 | ||||
21 | ||||
22 | ||||
23 | ||||
24 | ||||
25 | ||||
26 | ||||
27 | ||||
28 | ||||
Sheet1 |
Excel 2007 | ||||
---|---|---|---|---|
A | B | |||
1 | No. | Result | ||
2 | 1 | 1 | ||
3 | 2 | 1 | ||
4 | 3 | 1 | ||
5 | 4 | 2 | ||
6 | 5 | 2 | ||
7 | 6 | 2 | ||
8 | 7 | 3 | ||
9 | 8 | 3 | ||
10 | 9 | 3 | ||
11 | 10 | 4 | ||
12 | 11 | 4 | ||
13 | 12 | 4 | ||
14 | 13 | 5 | ||
15 | 14 | 5 | ||
16 | 15 | 5 | ||
17 | 6 | |||
18 | 6 | |||
19 | 6 | |||
20 | 7 | |||
21 | 7 | |||
22 | 7 | |||
23 | 8 | |||
24 | 8 | |||
25 | 8 | |||
26 | 9 | |||
27 | 9 | |||
28 | 9 | |||
Sheet1 |
Option Explicit
Sub ExpandNumbers()
' hiker95, 02/20/2014, ME758867
Dim c As Range, nr As Long, n As Long
Application.ScreenUpdating = False
Columns(2).ClearContents
With Cells(1, 2)
.Value = "Result"
.Font.Bold = True
End With
nr = 2: n = 0
For Each c In Range("A2", Range("A" & Rows.Count).End(xlUp))
If n = 0 Then
With Cells(nr, 2).Resize(3)
.Value = c.Value
.Font.Bold = True
End With
n = 1
ElseIf n = 1 Then
Cells(nr, 2).Resize(3).Value = c.Value
n = 0
End If
nr = nr + 3
Next c
Application.ScreenUpdating = True
End Sub
Many Thanks you for your reply
I may did not expalin well?
the required output needs as below
i use the loop statement but cannot get required output
Sub LoopA()
Dim i, j As Integer
j = 1
For i = 1 To 15
Cells(i, 1).Value = j
j = j + 1
Next i
End Sub
Sub LoopA()
Dim i, j, k As Long
k = 1
For j = 1 To 5
For i = 1 To 3
Cells(k, 1).Value = j
k = k + 1
Next i
Next j
End Sub