求助！连号汇总

jxang001

主要是检查有没有断号，把已存在的号码汇总，具体结果如附件！数据源的起号止号是当天使用的号码，需要汇总一个月的号码，汇总主要是按单位代码和符号汇总，如果断号的话，如果1组号码一个月用了1-200张，其中断号了一张100号，那么就出现两组起号1和止号99为一组，起号101和200为另一组。

一把小刀闯天下

'先对A:K列做下手工排序，没必要拿代码去排，自己测试一下，，，。

Option Explicit

Sub test()
  Dim arr, i, j, k, kk, n, sum(1), t
  With Sheets("原始数据")
    arr = .Range("a2:k" & .Cells(Rows.Count, "a").End(xlUp).Row + 1)
  End With
  ReDim brr(1 To UBound(arr, 1), 1 To 10)
  For i = 1 To UBound(arr, 1) - 1
    For j = i To UBound(arr, 1) - 1
      ReDim t(1) As String
      For k = 1 To 6
        t(0) = t(0) & arr(j, k): t(1) = t(1) & arr(j + 1, k)
      Next
      If t(0) <> t(1) Then
        For k = i To j
          If Len(arr(k, 7)) > 0 Then
            n = n + 1: t = arr(k, 8) + 1: sum(0) = arr(k, 10): sum(1) = arr(k, 9)
            For kk = k + 1 To j
              If arr(kk, 7) = t Then
                sum(0) = sum(0) + arr(kk, 10): sum(1) = sum(1) + arr(kk, 9)
                t = arr(kk, 8) + 1: arr(kk, 7) = vbNullString
              End If
            Next
            For kk = 1 To UBound(arr, 2) - 2: brr(n, kk) = arr(k, kk): Next
            brr(n, 8) = t - 1: brr(n, 9) = sum(1): brr(n, kk) = sum(0)
          End If
        Next
        i = j: Exit For
      End If
  Next j, i
  With Sheets("汇总结果").[a2]
    .Resize(Rows.Count - 1, UBound(brr, 2)).ClearContents
    .Resize(n, UBound(brr, 2)) = brr
  End With
End Sub

jxang001

一把小刀闯天下 发表于 2018-6-30 18:01
'先对A:K列做下手工排序，没必要拿代码去排，自己测试一下，，，。

Option Explicit

谢谢老师！！