如何根据填写的内容生成库位码？

魏加木

想实现的目标就是在sheet1页面填写好数据，然后按照格式生成数据写到sheet2页面的A列。

ykcbf1100

没明白楼主的取数规则。怎么就生成了那些库位码了。

baofa2

1. Sub test0() 'A、B 两列不知有变化木有，现写法基于两列相同
   
2.   Dim ar, br(100000, 0), cr(1 To 4) As String
   
3.   Dim i As Long, j As Long, k As Long, l As Long, m As Long
   
4.   ar = Range("A1").CurrentRegion.Resize(, 8).Value
   
5.   For i = 2 To UBound(ar)
   
6.     cr(1) = ar(i, 1)
   
7.     For j = ar(i, 3) To ar(i, 4)
   
8.       cr(2) = j
   
9.       For k = ar(i, 5) To ar(i, 6)
   
10.         cr(3) = k
    
11.         For l = ar(i, 7) To ar(i, 8)
    
12.           cr(4) = l
    
13.           br(m, 0) = Join(cr, "-")
    
14.           m = m + 1
    
15.         Next
    
16.       Next
    
17.     Next
    
18.   Next
    
19.   Range("N2").Resize(m) = br
    
20. End Sub

复制代码

gwjkkkkk

笛卡尔组合。。。

魏加木

baofa2 发表于 2024-4-6 20:10

感谢，就是这个思路

baofa2

魏加木 发表于 2024-4-6 20:26
感谢，就是这个思路

xiexl

1. Sub test()
   
2.     Dim i%, z%, j%, k%, l%, n%, arr(), brr()
   
3.     Dim d As Object, d1 As Object
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     Set d1 = CreateObject("Scripting.Dictionary")
   
6.     letters = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   
7.     For i = 1 To Len(letters)
   
8.         d(Mid(letters, i, 1)) = i
   
9.         d1(i) = Mid(letters, i, 1)
   
10.     Next i
    
11.     With Sheet1
    
12.         arr = .Range("a1").CurrentRegion
    
13.     End With
    
14.     For i = 2 To UBound(arr)
    
15.         For z = d(arr(i, 1)) To d(arr(i, 2))
    
16.             For j = arr(i, 3) To arr(i, 4)
    
17.                 For k = arr(i, 5) To arr(i, 6)
    
18.                     For l = arr(i, 7) To arr(i, 8)
    
19.                         n = n + 1
    
20.                         ReDim Preserve brr(1 To n)
    
21.                         brr(n) = d1(z) & "-" & j & "-" & k & "-" & l
    
22.                     Next
    
23.                 Next
    
24.             Next
    
25.         Next
    
26.     Next
    
27.     With Sheet2
    
28.         .Range("a1").Resize(.Rows.Count - 1, 1).ClearContents
    
29.         .Range("a1").Resize(UBound(brr)) = Application.Transpose(brr)
    
30.     End With
    
31. End Sub
    
32.    
    

复制代码

xiexl

不知道是不是这个意思

yynrzwh

1. Sub test()
   
2. 
   
3. ar = Sheet1.Range("a1").CurrentRegion
   
4. ReDim br(1 To 999999, 1 To 1)
   
5. For i = 2 To UBound(ar)
   
6.     s1 = VBA.Asc(ar(i, 1)): s2 = Asc(ar(i, 2))
   
7.     For x1 = s1 To s2
   
8.         For x2 = ar(i, 3) To ar(i, 4)
   
9.             For x3 = ar(i, 5) To ar(i, 6)
   
10.                 For x4 = ar(i, 7) To ar(i, 8)
    
11.                     s = VBA.Chr(x1) & "-" & x2 & "-" & x3 & "-" & x4
    
12.                     r = r + 1
    
13.                     br(r, 1) = s
    
14.                 Next
    
15.             Next
    
16.         Next
    
17.     Next
    
18. Next
    
19. 
    
20. With Sheet2
    
21.     .UsedRange.ClearContents
    
22.     .Range("a1").Resize(r) = br
    
23. End With
    
24. End Sub
    

复制代码

cnmlgb9998

PQ  很方便！！！！！！！！！！！！！