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

周进

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

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

一把小刀闯天下

就是10进制+34进制，10进制循环，34进制累加，但34进制累加是否进位并未明确。所以你这就变成了一个文字题，，，

xiangbaoan

周进 发表于 2020-5-19 21:24
34进制没有I与O

答非所问，话没读，图没看！有木有什么这我还知道！

周进

一把小刀闯天下 发表于 2020-5-19 21:51
就是10进制+34进制，10进制循环，34进制累加，但34进制累加是否进位并未明确。所以你这就变成了一个文字题 ...

没有10进制，变量中初始567CC到结束877MM为34进制，没有10进制。

一把小刀闯天下

周进 发表于 2020-5-30 13:13
没有10进制，变量中初始567CC到结束877MM为34进制，没有10进制。

'"567CC到结束877MM",个数有点多：4048628,至少4列输出 ，，，

Option Explicit

Sub test()
  Dim i, mark
  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", ",")
  Debug.Print c34to10("877MM", mark) - c34to10("567CC", mark) + 1
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

张小生

一把小刀闯天下 发表于 2020-5-31 16:04
'"567CC到结束877MM",个数有点多：4048628,至少4列输出 ，，，

Option Explicit

强大，收藏学习，初次接触到进制算法

张小生

周进 发表于 2020-5-30 13:13
没有10进制，变量中初始567CC到结束877MM为34进制，没有10进制。

能说一下为什么要用34进制来计算序列号吗

周进

张小生 发表于 2020-5-31 22:29
能说一下为什么要用34进制来计算序列号吗

产品的生产条码，用十进制位数太多

周进

问题已解决，感谢各位大神！
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
   Sheet1.Range("G3:GG2002").Clear
   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([d4].Value, mark): b = c34to10([d5].Value, mark)
   ReDim arr(1 To NUM, 1 To (b - a + 1) / NUM + 1) As String
   m = 0: n = 1: s = [c4].Value
   For i = a To b
     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 & 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

周进

一把小刀闯天下 发表于 2020-5-17 17:38
'凑了一个，条件好象多了，规则也不唯一，，，

Option Explicit

VBA实现条码比对小工具开发，求助大神！
http://club.excelhome.net/thread-1545575-1-1.html
(出处: ExcelHome技术论坛)
老师，帮帮忙！