数据递增

笑着...两年过去

初学VB，想到一个问题，求达人解答，最好能适用于大数据。呵呵


见附件： 求助.rar (10.24 KB, 下载次数: 15)

2014-9-17 18:23 上传

点击文件名下载附件

该贴已经同步到 笑着...两年过去的微博

aoe1981

初步看了下，似乎IL、RL值是多余的……好像和结果之间没有啥关系……各结果单号的生成……

aoe1981

1. Option Explicit
   
2. Public Sub danhao()
   
3. Dim arr, i%, j%, n&, m&, k&
   
4. arr = Range("a3:b7").Value
   
5. For i = 1 To UBound(arr)
   
6.     n = n + arr(i, 2)
   
7. Next i
   
8. ReDim brr(1 To n, 1 To 1)
   
9. m = 0
   
10. For i = 1 To UBound(arr)
    
11.     k = 0
    
12.     For j = 1 To arr(i, 2)
    
13.         m = m + 1
    
14.         k = k + 1
    
15.         brr(m, 1) = arr(i, 1) & Format(k, "000")
    
16.     Next j
    
17. Next i
    
18. Range("k1").Resize(m, 1) = brr
    
19. End Sub
    

复制代码

aoe1981

　　附件如下：
　　 求助aoe1981.rar (10.64 KB, 下载次数: 5)

2014-9-17 19:59 上传

点击文件名下载附件

yjh_27

1. Sub aa()
   
2. Dim brr()
   
3. r = Range("a" & Rows.Count).Row
   
4. arr = Range("a3:b" & r)
   
5. ReDim brr(1 To UBound(arr, 1) * 10, 1 To 3)
   
6. 
   
7. For i = 1 To UBound(arr, 1)
   
8.     For ii = 1 To arr(i, 2)
   
9.         bi = bi + 1
   
10.         brr(bi, 1) = arr(i, 1) & Format(ii, "000")
    
11.         brr(bi, 2) = Int(Rnd * 9) + 1
    
12.         brr(bi, 3) = Int(Rnd * 9) + 1
    
13.     Next
    
14. Next
    
15. 
    
16. Range("g3").Resize(bi, 3) = brr
    
17. 
    
18. End Sub
    

复制代码

wzsy2_mrf

1. Sub dhsc()
   
2.     Dim arr, i&, j&, rn%, brr, k&
   
3.     arr = Sheet1.Range("A2").CurrentRegion
   
4.     For i = 3 To UBound(arr)
   
5.         rn = rn + arr(i, 2)
   
6.     Next
   
7.     ReDim brr(1 To rn + 1, 1 To 3)
   
8.     brr(1, 1) = arr(2, 1)
   
9.     brr(1, 2) = arr(2, 3)
   
10.     brr(1, 3) = arr(2, 4)
    
11.     k = 1
    
12.     For i = 3 To UBound(arr)
    
13.         rn = arr(i, 2)
    
14.         For j = 1 To rn
    
15.             k = k + 1
    
16.             brr(k, 1) = arr(i, 1) & Format(j, "000")
    
17.             brr(k, 2) = Int(Rnd * 9 + 1)
    
18.             brr(k, 3) = Int(Rnd * 9 + 1)
    
19.         Next
    
20.     Next
    
21.     Sheet1.Range("k2").Resize(UBound(brr), 3) = brr
    
22. End Sub
    

复制代码

wzsy2_mrf

附件如下：

zax010

Sub zz()
    Dim c As Range
    For Each c In Range("A3:A" & [a1048576].End(3).Row)
        ReDim a(1 To c.Offset(0, 1).Value)
        For i = 1 To UBound(a)
            a(i) = c.Value & Format(i, "000")
        Next
        Cells(3 + n, 7).Resize(UBound(a), 1) = Application.Transpose(a)
        n = n + UBound(a)
    Next
    Cells(3, 8).Resize(n, 2) = "=RANDBETWEEN(1,9)"
End Sub

zax010

>>>>>>>>>>>>>>>
求助.rar (16.72 KB, 下载次数: 0)

2014-9-17 21:25 上传

点击文件名下载附件

aoe1981

我可能没有完全理解您的目的……不过，有个发现，当了官，就可以打散一些“小费”了……
我曾一段时间，也试图找到如何送人财富的方法……呵呵