VBA对序列号进行分段，谢谢！

周进

具体见附件

周进

求大神指导

fengjinbiao88

设置了动态分段的设置值，可以任意修改分段的范围，

fengjinbiao88

Sub ceshi()
Dim i, j, k, m, n, LL, HH, MM
Dim arr(), brr()
i = Range("c1040000").End(xlUp).Row - 3
k = 20  '分段的设置范围

MM = 0

m = i \ k   '取商
n = i Mod k '取余数

ReDim arr(1 To i)
For j = 1 To i
    arr(j) = Cells(j + 3, 3) & Cells(j + 3, 4)
Next

If m < 1 Then

    Range("g3").Resize(UBound(arr)) = Application.Transpose(arr)

    Else

    ReDim brr(1 To k, 1 To m + 1)

    For LL = 1 To m

        For HH = 1 To i
            
            MM = MM + 1
            
            brr(HH, LL) = arr(MM)
            
            If (HH Mod k) = 0 Then GoTo 100

        Next
        
100
    Next

    For jj = 1 To n
        
        MM = MM + 1
        brr(jj, LL) = arr(MM)
   
    Next
   
   
    Range("g3").Resize(UBound(brr), UBound(brr, 2)) = brr
End If


For ii = 1 To m + 1

    Cells(2, ii + 6) = "第" & ii & "段"

Next


End Sub

周进

谢谢！，不过功能上面还有差异。我要实现的是只要输入初始条码与结束条码号，右边会将该范围内所有的条码（34进制）显示在右边并按每段2000进行排列。

xiangbaoan

55555567LN 后为什么不是 J55555567LP ? 而是 J55555568LP 。

一把小刀闯天下

'凑了一个，条件好象多了，规则也不唯一，，，

Option Explicit

Const NUM As Long = 2000

Sub test()
  Dim s As String, i As Long, mark, m As Long, n As Long, p As Long, a, b, c, d, t, cnt
  t = Timer
  mark = Split("0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F,G,H,J,K,L,M,N,P,Q,R,S,T,U,V,W,X,Y,Z", ",")
  a = c34to10(Right([d4].Value, 2), mark): b = c34to10(Right([d5].Value, 2), mark)
  c = Left([d4].Value, Len([d4].Value) - 2): d = Left([d5].Value, Len([d5].Value) - 2)
  ReDim arr(1 To NUM, 1 To (d - c + 1) / NUM + 1) As String
  m = 0: n = 1: s = [c4].Value
  For i = c To d
    m = m + 1: p = a + cnt
    Do
      arr(m, n) = mark(p Mod 34) & arr(m, n)
      p = p \ 34
    Loop Until p = 0
    arr(m, n) = s & i & arr(m, n)
    If m = NUM Then m = 0: n = n + 1
    cnt = cnt + 1
  Next
  Debug.Print Timer - t, m, n
  [g3].Resize(NUM, n) = arr
  Debug.Print Timer - t
End Sub

Function c34to10(s, mark) As Long
  Dim i, n As Long, dic
  Set dic = CreateObject("scripting.dictionary")
  For i = 0 To UBound(mark)
    dic(mark(i)) = i
  Next
  s = UCase(s)
  For i = 1 To Len(s)
    n = n + dic(Mid(s, i, 1)) * 34 ^ (Len(s) - i)
  Next
  c34to10 = n
End Function

周进

确实还是不行，不过非常感谢！

周进

xiangbaoan 发表于 2020-5-17 09:46
55555567LN 后为什么不是 J55555567LP ? 而是 J55555568LP 。

34进制没有I与O

周进

fengjinbiao88 发表于 2020-5-13 02:38
Sub ceshi()
Dim i, j, k, m, n, LL, HH, MM
Dim arr(), brr()

只需要输入起止的条码，不要中间的条码