[英]VBA EXCEL : Pattern creation function replacing numbers with characters
我已經寫了下面提到的代碼,但是它不起作用。 有人可以幫忙嗎?
說明:已設置7或8位數字。 如果數字是8位數字,則刪除前2個數字;如果數字是7位數字,則刪除首個數字。 剩下的6位數字使每個數字都可以無限制地重復。 因此,可以有一個介於000001和999999之間的數字。(計算左側的零)。
該代碼在前3位數字上有效,但稍后卻無法正常使用,盡管我使用的是相同的邏輯。 該代碼的功能是通過將數字轉換為字符來生成所有可能的模式。
約束:
在這種邏輯下:
Private Sub CommandButton1_Click()
Dim GSM_Counter, GSM, GSM_Range, a, b, c, d, e, f As String
Dim GSM_length, Num1, Num2, Num3, Num4, Num5, Num6, a1, b1, c1, d1, e1, f1 As integer
GSM_Counter = Application.WorksheetFunction.CountA(Range("A:A"))
For i = 2 To GSM_Counter
GSM_length = Len(Range("A" & i))
Select Case GSM_length
Case Is = 8
Range("B" & i) = Left(Range("A" & i), 2)
Num1 = Right(Left(Range("A" & i), 3), 1)
Num2 = Right(Left(Range("A" & i), 4), 1)
Num3 = Right(Left(Range("A" & i), 5), 1)
Num4 = Right(Left(Range("A" & i), 6), 1)
Num5 = Right(Left(Range("A" & i), 7), 1)
Num6 = Right(Left(Range("A" & i), 8), 1)
Case Is = 7
Range("B" & i) = Left(Range("A" & i), 1)
Num1 = Right(Left(Range("A" & i), 2), 1)
Num2 = Right(Left(Range("A" & i), 3), 1)
Num3 = Right(Left(Range("A" & i), 4), 1)
Num4 = Right(Left(Range("A" & i), 5), 1)
Num5 = Right(Left(Range("A" & i), 6), 1)
Num6 = Right(Left(Range("A" & i), 7), 1)
End Select
Range("C" & i) = Num1
Range("D" & i) = Num2
Range("E" & i) = Num3
Range("F" & i) = Num4
Range("G" & i) = Num5
Range("H" & i) = Num6
Next i
For k = 2 To GSM_Counter
a1 = Range("C" & k)
b1 = Range("D" & k)
c1 = Range("E" & k)
d1 = Range("F" & k)
e1 = Range("G" & k)
f1 = Range("H" & k)
a = "a"
Range("K" & k) = a
If b1 = a1 Then
b = "a"
Else
b = "b"
End If
Range("L" & k) = b
If c1 = a1 Then
c = "a"
ElseIf c1 = b1 Then
c = "b"
Else
c = "c"
End If
Range("M" & k) = c
If d1 = a1 Then
d = "a"
ElseIf d1 = b1 Then
d = "b"
ElseIf d1 = c1 Then
d = "c"
Else
d = "d"
End If
Range("N" & k) = d
If e1 = a1 Then
e = "a"
ElseIf e1 = b1 Then
e = "b"
ElseIf e1 = c1 Then
e = "c"
ElseIf e1 = d1 Then
e = "d"
Else
e = "e"
End If
Range("O" & k) = e
If f1 = a1 Then
f = "a"
ElseIf f1 = b1 Then
f = "b"
ElseIf f1 = c1 Then
f = "c"
ElseIf f1 = d1 Then
f = "d"
ElseIf f1 = e1 Then
f = "e"
Else
f = "f"
End If
Range("P" & k) = f
Next k
End Sub
這是另一種方式。
'~~> Test Data
Sub Sample()
Dim TestArray(1 To 6) As Long
Dim i As Long
TestArray(1) = 468013: TestArray(2) = 12234455: TestArray(3) = 234523
TestArray(4) = 44444444: TestArray(5) = 123: TestArray(6) = 111222
For i = 1 To 6
Debug.Print TestArray(i) & " --> " & Encrypt(TestArray(i))
Next i
End Sub
'~~> Actual Function
Function Encrypt(n As Long) As String
Dim j As Long, k As Long, sNum As String
sNum = Format(CLng(Right(n, 6)), "000000")
j = 97
For k = 1 To 6
If IsNumeric(Mid(sNum, k, 1)) Then
sNum = Replace(sNum, Mid(sNum, k, 1), Chr(j))
j = j + 1
End If
Next k
Encrypt = sNum
End Function
產量
468013 --> abcdef
12234455 --> abccdd
234523 --> abcdab
44444444 --> aaaaaa
123 --> aaabcd
111222 --> aaabbb
編輯 :
如果您打算將其用作工作表功能,但不確定要輸入哪種類型,請進行更改
Function Encrypt(n As Long) As String
至
Function Encrypt(n As Variant) As String
我建議您了解Chr()
以及可能的Asc()
VBA函數,以及有關數字和字母字符如何轉換為ASCII代碼字符的一般知識。 我可能看錯了東西,但是我認為示例,您的描述和提供的實際代碼之間存在一些矛盾。 這是將模式生成放入用戶定義函數或UDF中的一種方法。
Function num_2_alpha(sNUM As String)
'ASCII 0-9 = 46-57, a-z = 97-122
Dim tmp As String, i As Long, c As Long
sNUM = Right(sNUM, 6)
tmp = Chr(97) ' =a
For i = 2 To 6
If CBool(InStr(1, Left(sNUM, i - 1), Mid(sNUM, i, 1))) Then
tmp = tmp & Mid(tmp, InStr(1, Left(sNUM, i - 1), Mid(sNUM, i, 1)), 1)
Else
'tmp = tmp & Chr(i + 96)
c = c + 1
tmp = tmp & Chr(c + 97) 'alternate (code) method
End If
Next i
num_2_alpha = tmp
End Function
請注意,我提供了一種已注釋掉的替代方法。 這條線或上方的那條線應該處於活動狀態; 一次都不會。 這些是產生的結果。
附錄:我相信我最近的編輯應該有助於使您符合注釋中的示例。 代碼和圖像已更新。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.