HP1020打印名片纸的时候出现重影怎么办？

求助于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。收起