|
Sub demo()
Randomize
[A2:F99999].ClearContents
On Error Resume Next
ReDim arr(1 To 4096, 1 To 2)
For i = 1 To 4096
v = Right("00" & Hex(i - 1), 3)
If IsNumeric(Mid(v, 1, 1)) + IsNumeric(Mid(v, 1, 1)) + IsNumeric(Mid(v, 1, 1)) Then
n = n + 1
arr(i, 1) = v
arr(i, 2) = Rnd
End If
Next
[M1].Resize(n, 2) = arr
[M1].Resize(n, 2).Sort [L1]
b = Range("M1:M" & n): [M1:N4096].ClearContents
a = [H1].CurrentRegion
cnt = a(UBound(a), 4)
ReDim c(1 To 4096, 1 To 6)
For i = 2 To UBound(a)
If a(i, 1) = 0 Then GoTo 1
For j = 1 To a(i, 5)
r = r + 1
c(r, 1) = a(i, 2)
c(r, 2) = a(i, 3)
c(r, 3) = a(i, 4) & b(r, 1)
c(r, 4) = Mid(b(r, 1), 1, 1) & ".bmp"
c(r, 5) = Mid(b(r, 1), 2, 1) & ".bmp"
c(r, 6) = Mid(b(r, 1), 3, 1) & ".bmp"
Next
1 Next
[a2].Resize(r, 6) = c
End Sub
|
|