求助于VBA高手，关于分列打印求
稍微修改一下代码就可以了，
Option Explicit
Private Sub CommandButton1_Click()
Dim rng As Range, arr, arr1, arr2, i%, j%
Set rng = Sheet1。 Range("A2:C" & Sheet1。[A65536]。End(xlUp)。Row)
rng。Sort rng。Cells(1, 1) '对准考证号进行排序
arr = rng。Value '赋值给数组
Set rng = Nothing
ReDim arr1(1 To UBound(arr), 1 To 3)
ReDim arr2(1...全部
稍微修改一下代码就可以了，
Option Explicit
Private Sub CommandButton1_Click()
Dim rng As Range, arr, arr1, arr2, i%, j%
Set rng = Sheet1。
Range("A2:C" & Sheet1。[A65536]。End(xlUp)。Row)
rng。Sort rng。Cells(1, 1) '对准考证号进行排序
arr = rng。Value '赋值给数组
Set rng = Nothing
ReDim arr1(1 To UBound(arr), 1 To 3)
ReDim arr2(1 To UBound(arr), 1 To 3)
For i = 1 To UBound(arr) - 1 Step 2
If Left(arr(i + 1, 1), 3) = Left(arr(i, 1), 3) Then
j = j + 1
arr1(j, 1) = arr(i, 1)
arr2(j, 1) = arr(i + 1, 1)
arr1(j, 2) = arr(i, 2)
arr2(j, 2) = arr(i + 1, 2)
arr1(j, 3) = arr(i, 3)
arr2(j, 3) = arr(i + 1, 3)
Else
j = j + 1
arr1(j, 1) = arr(i, 1)
arr2(j, 1) = ""
arr1(j, 2) = arr(i, 2)
arr2(j, 2) = ""
arr1(j, 3) = arr(i, 3)
arr2(j, 3) = ""
i = i - 1
End If
Next
Sheet2。
[2:65536]。ClearContents
Sheet2。[A2]。Resize(UBound(arr), 3) = arr1
Sheet2。[E2]。Resize(UBound(arr), 3) = arr2
Sheet2。
Activate
End Sub
>>>>>>>>>>>>>>>>>>>>>>原回答>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
给你做了一个，采用数组存取运算，速度应该很快的。
Option Explicit
Private Sub CommandButton1_Click()
Dim rng As Range, arr, arr1, arr2, i%, j%
Set rng = Sheet1。
Range("A2:A" & Sheet1。[A65536]。End(xlUp)。Row)
rng。Sort rng。Cells(1, 1) '对准考证号进行排序
arr = rng。Value '赋值给数组
Set rng = Nothing
ReDim arr1(1 To UBound(arr))
ReDim arr2(1 To UBound(arr))
For i = 1 To UBound(arr) - 1 Step 2
If Left(arr(i + 1, 1), 3) = Left(arr(i, 1), 3) Then
j = j + 1
arr1(j) = arr(i, 1)
arr2(j) = arr(i + 1, 1)
Else
j = j + 1
arr1(j) = arr(i, 1)
arr2(j) = ""
i = i - 1
End If
Next
Sheet2。
[2:65536]。ClearContents
Sheet2。[A2]。Resize(UBound(arr), 1) = Application。Transpose(arr1)
Sheet2。
[E2]。Resize(UBound(arr), 1) = Application。Transpose(arr2)
Sheet2。Activate
End Sub。收起
