Dùng VBA để tổ hợp các kí tự

Chia sẻ bởi:hands

★★★★★

‹ Hỏi cách dùng hàm countblank với các... Cần Giúp đỡ công thức Excel chia... ›

Quảng cáo

Chào mọi người !
Mình đang muốn viết một hàm VBA để tổ hợp một chuỗi kí tự có độ dài cố định 21 kí tự được tổ hợp từ Số 0->9 và chữ từ A->Z (phân biệt cả chữ thường và chữ hoa)
như ví dụ bên dưới. Các pro giúp mình giải quyết với ạ. Mình làm một số cách nhưng chưa ra. làm bo bằng tay thì lâu quá mà lại còn sót nữa 205

Dưới đây là hàm lấy ngẫu nhiên 21 ký tự, không phải liệt kê:

Public Function RandString(ByVal NumOfString As Long) As String
Const s As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" '<=Change here
Dim i As Long
Dim rd As Long
Dim lenS As Long
Dim temp As String
lenS = Len(s)
Randomize
If NumOfString > 0 Then
For i = 1 To NumOfString
rd = Int(Rnd() * lenS) + 1
temp = temp & Mid(s, rd, 1)
Next i
RandString = temp
End If
End Function

Cách sử dụng:

=RandString(21)

1. Có thể tạo chuỗi ngẫu nhiên có độ dài khác bằng cách thay số 21

2. Có thể thêm, bớt ký tự chuỗi s trong code

www.giaiphapexcel.com/diendan/threads/d%C3%B9ng-vba-%C4%91%E1%BB%83-t%E1%BB%95-h%E1%BB%A3p-c%C3%A1c-k%C3%AD-t%E1%BB%B1.162549/#post-1084751

Tương tự ở đây: Tạo bộ mã 16 ký tự không trùng:
www.excelforum.com/excel-programming-vba-macros/1391339-issues-w-formula-to-generate-unique-16-character-strings-w-upper-lower-letters-numbers.html#post5741763
VBA code solution,with button click to genarate random unique code
Choose a range/cell then hit button
(This sample code for less than 1000 codes. Add more if want to get more: Dim arr… and for k=1 to …)
Option Explicit
Sub test()
Dim i&, k&, r&, st As String, keyw As String, cell As Range
Dim arr(1 To 1000, 1 To 1), dic As Object
Set dic = CreateObject("Scripting.dictionary")
st = "QWERTYUIOPASDFGHJKLZXCVBNMqwertyuiopasdfghjklzxcvbnm0123456789"
Randomize
For k = 1 To 1000
keyw = ""
For i = 1 To 16
r = Int(Rnd * 62 + 1)
keyw = keyw & Mid(st, r, 1)
Next
If Not dic.exists(keyw) Then
dic.Add keyw, ""
arr(k, 1) = keyw
End If
Next
k = 0
For Each cell In Selection
k = k + 1
cell.Value = arr(k, 1)
Next
End Sub

Thay i=1 to 16 thành 21

www.excelforum.com/excel-programming-vba-macros/1391339-issues-w-formula-to-generate-unique-16-character-strings-w-upper-lower-letters-numbers.html#post5741763

Số lượng chuỗi là hữu hạn & sẽ phải ấn định trước:

Sub TaoChuoi21()
Const Alf As String = "0123456789ABCDEFGHIJKLMNOPQRTSUVWXYZ"
Dim Tmp As Byte, J0 As Long, Solg As Integer, Dem As Byte
Dim StrC As String, GPE As String

1 'Xáo Trôn Chuôi '
Randomize: StrC = Alf
For J0 = 1 To 999
Tmp = 6 + 12 * Rnd() 1
If Tmp < 13 Then
StrC = Mid(StrC, Tmp + 7, Len(StrC)) & Mid(StrC, Tmp, 7) & Left(StrC, Tmp – 1)
Else
StrC = Mid(StrC, Tmp, 7) & Left(StrC, Tmp – 1) & Mid(StrC, Tmp + 7, Len(StrC))
End If
Next J0
2 ' Cát Doan '
Solg = InputBox("Ban Cân Bao Nhiêu Kêt Qua:", "Xin Chào Nha!", "9")
If Solg > 9 Then Exit Sub
For J0 = 1 To Solg
GPE = GPE & StrC
Next J0
For J0 = 1 To Len(GPE) Step 21
Dem = Dem + 1: If Dem > Solg Then Exit For
.Offset(Dem).Value = Mid(GPE, J0, 21)
Next J0
End Sub