很有规律的提取数字并编号，写了段代码，运行不出来，望高手指点

wine0431

需要在B列填写编号（从HT18063-1，HT18063-2，HT18063-3，HT18063-4，HT18063-5，HT18063-6……）。规律如下：开头为C列前7个字符（HT18063），之后加上“-”，最后的数字按照C列尾号108个，108个, 108个, 108个，120个（108+12）这样5个数组循环，分别为HT18063-1（尾号为1-108），HT18063-2（尾号为109-216），HT18063-3（尾号为217-324），HT18063-4（尾号为325-432），HT18063-5（尾号为433-552），接着类似HT18063-6，HT18063-7，HT18063-8，HT18063-9，HT18063-10。自己写了段运行不对，望高手指正


Sub title()
Dim i, j, k As Integer, b As String

For i = 2 To ActiveSheet.[A65536].End(xlUp).Row
b = Cells(i, 2)
j = 0
Do While n < 552
m = Val(Right(Range(i, 3), 4))
n = m - 552 * j

If n <= 540 Then
a = Int((n - 1) / 108) + 1 + 5 * j
If n >= 541 And n <= 552 Then
a = 5 * (j + 1)
Else: j = j + 1
Cells(i, 2) = Left(b, 7) & "-" & a
End If

Next i
End Sub

zopey

Sub title()
Dim arr, k0
k0 = [c1].End(4).Row - 1
arr = [c2].Resize(k0, 1)

For i = 1 To k0
   b1 = Left(arr(i, 1), 7)
   b2 = Val(Right(arr(i, 1), 4))
   
   c1 = Int(b2 / 552)
   c2 = b2 - c1 * 552
   c3 = Application.Lookup(c2, Array(0, 1, 109, 217, 325, 433), Array(0, 1, 2, 3, 4, 5))
   Cells(i + 1, 2) = b1 & "-" & c1 * 5 + c3
Next

End Sub

lsdongjh

1. Sub Test()
   
2.     Dim lngRows As Long
   
3.     Dim lngRow As Long
   
4.     Dim arr As Variant
   
5.     Dim strFirst As String, strID As String
   
6.     Dim intVal As Integer, intMod As Integer, intQuotient As Integer
   
7.    
   
8.     lngRows = Sheet1.Range("C" & Rows.Count).End(xlUp).Row
   
9.     arr = Sheet1.Range("A2:C" & lngRows)
   
10.    
    
11.     strFirst = arr(1, 3)
    
12.     strFirst = Left(Trim(strFirst), 7) 'strFirst = "HT18063"
    
13.     For lngRow = 1 To UBound(arr)
    
14.         intVal = Val(Right(Trim(arr(lngRow, 3)), 4))
    
15.         intQuotient = (intVal - 1) \ 552 '每552个号为一大组，108*4+120
    
16.         intMod = (intVal - 1) Mod 552
    
17.         If intMod > 431 Then '第5组的编号直接计算
    
18.             strID = 5 + 5 * intQuotient
    
19.         Else
    
20.             intMod = intMod \ 108
    
21.             strID = intMod + 1 + 5 * intQuotient
    
22.         End If
    
23.         
    
24.         arr(lngRow, 2) = strFirst & "-" & strID
    
25.     Next
    
26.    
    
27.     Sheet1.Range("A2:C" & lngRows) = arr
    
28. End Sub

复制代码

wine0431

lsdongjh 发表于 2018-8-24 15:48

谢谢，楼上的效果更好，因为我这只是一部分表格，还有其他的需要合并，前面字母需要提取

wine0431

zopey 发表于 2018-8-24 15:08
Sub title()
Dim arr, k0
k0 = [c1].End(4).Row - 1

c3 = Application.Lookup(c2, Array(0, 1, 109, 217, 325, 433), Array(0, 1, 2, 3, 4, 5))
能否请教下这句是什么意思，我看得懂大意，c2的值可以是0-551，不知道中间Array(0, 1, 109, 217, 325, 433)代表什么意思，是表明数组的下界吗？举个例子，如果c2= 227,那么他落在Array(0, 1, 109, 217, 325, 433)的第四和第五之间，取4，所以返回Array(0, 1, 2, 3, 4, 5)的4。是这样的吗？

zopey

wine0431 发表于 2018-8-24 16:24
c3 = Application.Lookup(c2, Array(0, 1, 109, 217, 325, 433), Array(0, 1, 2, 3, 4, 5))
能否请教下 ...

if c2>=433 then
  c3=5
elseif  c2>=325 then
   c3=4
elseif  c2>=217 then
   c3=3
elseif  c2>=109 then
   c3=2
elseif  c2>=1 then
   c3=1
elseif  c2>=0 then
   c3=0
end if

zopey

当c2 =227 代码会执行到

elseif  c2>=217 then
      c3=3

退出 if ，此时c3 =3 。

wine0431

zopey 发表于 2018-8-24 16:32
当c2 =227 代码会执行到

elseif  c2>=217 then

好的，那个array中就是下界了，知道了，谢谢啦

lsdongjh

wine0431 发表于 2018-8-24 16:17
谢谢，楼上的效果更好，因为我这只是一部分表格，还有其他的需要合并，前面字母需要提取

看清楚逻辑，我和楼上的是一样的，只是我的是计算，他的是 罗列了参数值

wine0431

lsdongjh 发表于 2018-8-24 16:38
看清楚逻辑，我和楼上的是一样的，只是我的是计算，他的是 罗列了参数值

好的，学习了，非常感谢