|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub TEST()
With Sheets("原始数据")
R = .Cells(Rows.Count, 2).End(3).Row + 1
ARR = .Range("A1:C" & R)
End With
N = 1
With Sheets("名单")
For I = 2 To UBound(ARR)
If ARR(I, 2) <> ARR(I - 1, 2) Then
If R1 > 0 Then
.Cells(R1, 2) = M
.Cells(R1, 1).Resize(1, 7).Interior.ColorIndex = 40
End If
J = 1: M = 0
N = N + 1
R1 = N
.Cells(N, 1) = ARR(I, 2)
N = N + 1
.Cells(N, 1) = ARR(I, 3)
M = M + 1
Else
J = J + 1
If J = 8 Then
J = 1
N = N + 1
End If
.Cells(N, J) = ARR(I, 3)
M = M + 1
End If
Next
End With
End Sub
|
|