Question

VBA中如何将多行多列数据存入数组并利用字典实现分页

sheet1中有如下N行数据
0402-60-PH1-4-0445-001 1 陈岑 1
0402-60-PH1-4-0445-002 2 陈岑 2
0402-60-PH1-4-0445-003 3 陈岑 3
0402-60-PH1-4-0445-004 4 陈岑 4
0402-60-PH1-4-0445-005 5 陈岑 5
0402-60-PH1-4-0445-006 6 陈岑 6
0402-60-PH1-4-0445-007 7 陈岑 7

Answer 1

Sub CreateTabTwo2()

Dim cJG As Range
Dim c1 As Range, c2 As Range, rng1 As Range, rngZY As Range, rngZ As Range, rngY As Range
Dim i&, r&, r1&, rZ&, rF&, rFf&, irS&, pN, pNs&
Dim Arr1, d1, d2, rs, tmp, tmp2
Dim iTimer

iTimer = Timer
Application.StatusBar = "正在 获取数据，请稍候……"
Application.ScreenUpdating = False
With Sheet5
Arr1 = .Cells(1, 1).Resize(.Range("A65536").End(xlUp).Row + 1).Cells
ReDim arr2(LBound(Arr1, 1) To UBound(Arr1, 1))
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
r = LBound(Arr1, 1) + 1
tmp = Left(Arr1(r, 1), 18)
d1(r) = tmp
tmp2 = tmp
d2(r) = Right(Arr1(r, 1), 3)
For i = r + 1 To UBound(Arr1, 1)
tmp = Left(Arr1(i, 1), 18)
' If MsgBox(d1.Count & vbCrLf & tmp & vbCrLf & tmp2, vbOKCancel) <> vbOK Then GoTo 1000
If tmp <> tmp2 Then d1(i) = tmp: tmp2 = tmp
d2(i) = Right(Arr1(i, 1), 3)
Next
End With

Application.ScreenUpdating = True
Application.StatusBar = "正在 调整格式，请稍候……"
Application.ScreenUpdating = False

With Sheet6
…………
以前回答过类似的问题，Hi我吧，给你QQ，详细解答