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

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

复制代码

cnmlgb9998

改了一下，用 ACC 循环，精简代码步骤。。。。。。

swl4561255

公式：

1. =MID("AB",INT((ROW(A1)-1)/H$2/F$2/D$2)+1,1)&"-"&INT((ROW(A1)-1)/$F$2/$H$2)+1&"-"&MOD(INT((ROW(A1)-1)/5),F$2)+1&"-"&MOD(ROW(A1)-1,H$2)+1

复制代码