การใช้ VBA สร้าง Code จากรายชื่อตามเงื่อนไขที่กำหนด

มีเพื่อนสมาชิกใน Pantip ได้สอบถามถึงโปรแกรมหรือใช้ฟังก์ชั่นของ Excel ในการสร้าง Code ตามเงื่อนไข ซึ่งต้องการจัดเก็บประวัติเรียงตามตัวอักษรตัวแรกของชื่อ แล้วตามด้วยตัวเลขตามอักษรอีก 3 หลัก และมีเครื่องหมาย “-“ คั่นระหว่างชื่อและนามสกุล โดยแสดงชื่อและนามสกุลเป็นเลข 4 หลัก เท่านั้น โดยมีเงื่อนไขการเปลี่ยนตัวอักษรเป็นตัวเลขดังนี้

ก – ง แทนด้วยหมายเลข 1 ( ก ข ค ฆ ง)
จ – ญ แทนด้วยหมายเลข 2 (จ ฉ ช ซ ฌ ญ )
ฎ – ณ แทนด้วยหมายเลข 3 (ฎ ฏ ฐ ฑ ฒ ณ)
ด – น แทนด้วยหมายเลข 4 (ด ต ถ ท ธ น)
บ – ฟ แทนด้วยหมายเลข 5 (บ ป ผ ฝ พ ฟ)
ภ – ฤ แทนด้วยหมายเลข 6 (ภ ม ย ร ล ว ฤ)
ศ – ฮ แทนด้วยหมายเลข 7 (ศ ษ ส ห ฬ อ ฮ)

ตัวอย่าง
เพทาย บรรจง เลขรหัสในการค้นหาคือ พ460-5662
ประชุม แก่นทรัพย์ เลขรหัสในการค้นหาคือ ป626-1446

หมายเหตุ

1. หากชื่อหรือนามสกุลในหลักใดไม่มีตัวอักษรให้แสดงเป็นเลข 0
2. นับเฉพาะตัวอักษรเท่านั้น

ในช่วงรอชมฟุตบอลโลก 2010 คู่ชิงที่ 3 ระหว่างเยอรมันและอุรุกวัยผมได้ลองเขียน Code VBA เพื่อแก้ปัญหาดังกล่าว ซึ่งพบว่าสามารถให้คำตอบที่ถูกต้องตามที่โจทย์ถามมา โดยได้เขียนเป็นฟังก์ชั่นชื่อ GenerateCode มีรายละเอียดตามด้านล่างครับ

1. เข้าโปรแกรม Excel
2. กดแป้น Alt+F11 เพื่อเปิด VBE
3. เลือกเมนู Insert > Module
4. Copy Code ด้านล่างไปวาง
   
   

   Option Explicit
   Function GenerateCode(r As Variant) As String
       Dim i As Integer, k As Integer
       Dim t As String, tt As String
       Dim t0 As String, t1 As String
       Dim t22 As String
       tt = Left(r, Application.Find(" ", r) - 1) & "000"
       t22 = Mid(r, Application.Find(" ", r) + 1, 255) & "000"
           Select Case Mid(r, 1, 1)
               Case "เ", "ไ", "ใ", "โ", "แ"
                   t1 = Mid(r, 2, 1)
                   k = 3
               Case Else
                   t1 = Left(r, 1)
                   k = 2
           End Select
       For i = k To Len(tt)
           Select Case Mid(tt, i, 1)
               Case "ก", "ข", "ค", "ฆ", "ง"
                       t = t & 1
               Case "จ", "ฉ", "ช", "ซ", "ฌ", "ญ"
                       t = t & 2
               Case "ฎ", "ฏ", "ฐ", "ฑ", "ฒ", "ณ"
                       t = t & 3
               Case "ด", "ต", "ถ", "ท", "ธ", "น"
                       t = t & 4
               Case "บ", "ป", "ผ", "ฝ", "พ", "ฟ"
                       t = t & 5
               Case "ภ", "ม", "ย", "ร", "ล", "ว", "ฤ"
                       t = t & 6
               Case "ศ", "ษ", "ห", "ฬ", "อ", "ฮ"
                       t = t & 8
               Case 0
                       t = t & 0
           End Select
       Next
       For i = 1 To Len(t22)
           Select Case Mid(t22, i, 1)
               Case "ก", "ข", "ค", "ฆ", "ง"
                    t0 = t0 & 1
               Case "จ", "ฉ", "ช", "ซ", "ฌ", "ญ"
                    t0 = t0 & 2
               Case "ฎ", "ฏ", "ฐ", "ฑ", "ฒ", "ณ"
                     t0 = t0 & 3
               Case "ด", "ต", "ถ", "ท", "ธ", "น"
                     t0 = t0 & 4
               Case "บ", "ป", "ผ", "ฝ", "พ", "ฟ"
                     t0 = t0 & 5
               Case "ภ", "ม", "ย", "ร", "ล", "ว", "ฤ"
                     t0 = t0 & 6
               Case "ศ", "ษ", "ห", "ฬ", "อ", "ฮ"
                     t0 = t0 & 8
               Case 0
                     t0 = t0 & 0
           End Select
       Next
       GenerateCode = t1 & Left(t, 3) & "-" & Left(t0, 4)
   End Function

   
   
   
5. กดแป้น Alt+Q เพื่อกลับไปยังโปรแกรม Excel
   
6. สมมุติ ข้อมูลชื่ออยู่ที่คอลัมน์ A เริ่มที่ A1 ที่ B1 คีย์
   =GenerateCode(A1)
   Enter > Copy ลงด้านล่าง

Note: หากยังไม่ได้กำหนดให้โปรแกรมใช้ Macro ได้ ให้เข้าไปกำหนดที่ Tools > Macro > Security > กำหนดเป็น Medium หรือ Low หากกำหนดเป็น Medium จะต้อง คลิกยอมรับการใช้งาน Macro ตอนเปิดไฟล์ด้วยครับ

ภาพตัวอย่างการใช้งาน