ลองลบค่าต่าง ๆ ในบรรทัดที่ 1:28 ในชีท Crypto ทิ้งไปแล้ว Run Code ด้านล่างดูครับ
Code: Select all
Public Sub Crypto()
''''''''''''''''''''''''''''' Declarations variable'''''''''''''''''''''''''''''''''''''''
Dim Key As String, Message As String, PlainText As String, Longkey As String
Dim encode As String, Decode As String, EnCol As String, EnRow As String
Dim i As Integer, p As Integer, r As Integer, c As Integer
Dim l As Integer, a(1 To 26, 1 To 26) As Variant, ta As Variant, tb(1 To 26) As Variant
Dim m As Integer, t As String, n As Integer, o As Integer
ta = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", _
"P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
t = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
t = Application.Rept(t, 2)
For l = 1 To 26
For m = 1 To 26
a(l, m) = Mid(t, m + n, 1)
Next m
n = n + 1
Next l
Key = InputBox("Enter the key of encryption") ' get Key
Key = UCase(Key) ' change all key to uppercase letters
Message = InputBox("Enter the message that you want to send") ' get Message
Message = LCase(Message) ' change all message to lowercase letter
PlainText = Replace(Message, " ", "") ' cut space in Message by replacement and put into variable(Plaintext)
Longkey = Left(Application.WorksheetFunction.Rept(Key, 10), Len(PlainText)) ' cut letter from left of Right_plaintext
MsgBox ("Key = " & Key) ' show key
Worksheets("Crypto").Range("B29").Value = Key 'Set the value to the cell of the range"B29"
MsgBox ("Message = " & Message) ' show message
Worksheets("Crypto").Range("B30").Value = Message 'Set the value to the cell of the range"B30"
MsgBox ("PlainText = " & PlainText) ' show Plaintext
Worksheets("Crypto").Range("B31").Value = PlainText 'Set the value to the cell of the range"B30"
MsgBox ("Longkey = " & Longkey) ' show long key
Worksheets("Crypto").Range("B32").Value = Longkey 'Set the value to the cell of the range"B31"
''''''''''''''''''''''''''''''''' Encode ''''''''''''''''''''''''''''''''''''''''''''''
p = 1
For i = 1 To Len(Message) ' Loop for Encode
EnCol = Mid(Message, i, 1) ' Sub Message
If EnCol = " " Then ' Check if Sub Message equal space Add space to encode
encode = encode + " "
p = p - 1
Else
EnRow = Mid(Longkey, p, 1) ' Sub Longkey
r = Application.Match(EnRow, ta, 0) 'find EnRow in column A return Index
r = r + 1 'Not Found row A1
c = Application.Match(EnCol, ta, 0) 'find EnCol in row And return Index
encode = encode + a(r - 1, c) 'return the value to the cell
End If
p = p + 1
Next i
Worksheets("Crypto").Range("b33").Value = encode 'Set the value to the cell of the range"B33"
MsgBox ("Encode = " & encode) ' show Encode
'''''''''''''''''''''''''''''''''''''''''''Decode''''''''''''''''''''''''''''''''
p = 1
For i = 1 To Len(Message) ' Loop for Encode
EnCol = Mid(encode, i, 1) ' Sub Encode
If EnCol = " " Then ' Check if Sub Encol equal space Add space to encode
Decode = Decode + " "
p = p - 1
Else
EnRow = Mid(Longkey, p, 1) ' Sub Longkey
r = Application.Match(EnRow, ta, 0) 'find EnRow in column A return Index
r = r + 1 'Not Found row A1
For o = 1 To 26
tb(o) = a(r, o)
Next o
c = Application.Match(EnCol, tb, 0) + 1 'find Encol in row
Decode = Decode + a(1, c)
End If
p = p + 1
Next i
Worksheets("Crypto").Range("b34").Value = LCase(Decode) 'Set the value to the cell of the range"B34"
MsgBox ("Decode = " & Decode) ' show Decode
'Restore the original style.("Normal" is a name for the default style.)
MsgBox ("Formatting has been applied")
Range("B29:B34").ClearContents
Range("B29:B34").Style = "Normal"
MsgBox ("Original formatting")
End Sub
snasui.com ยินดีต้อนรับ 
สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ 
โปรดทราบ 
