สูครแปงตัวเลขเป็นคำ
Posted: Thu Dec 31, 2020 12:52 pm
เราอยากทำตัวเลขเป็นคำนั้น เราใช้ =BAHTTEXT() แต่พอดีผมไม่อยากใช้สูตรนี้ครับ เราจะใช้สูตรอื่นได้ หรือ เปล่าครับ
คลังคำตอบแห่งความรู้จากคนไทย เพื่อโลกที่ต้องการเข้าใจในสิ่งเล็ก ๆ อย่างลึกซึ้ง
http://www.snasui.com/
ยังไม่ใช้ครับผมpuriwutpokin wrote: Thu Dec 31, 2020 5:30 pm ต้องการให้คำอ่าน อ่านตัวเลขมาเป็นแบบไหนครับ ลองใส่ตัวอย่างคำนั้นๆมาดูครับ
หรือตัองการแค่คำที่มีแต่ตัวเลขก็ใช้เป็น
A1=SUBSTITUTE(BAHTTEXT(A1),"บาทถ้วน","")
Code: Select all
Option Explicit
'Main Function
Function SpellNumber(ByVal MyNumber)
Dim Dollars, Cents, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = "rao"
Place(3) = "]hko"
Place(4) = "8N"
Place(5) = "rao8N"
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, ".")
' Convert cents and set MyNumber to dollar amount.
If DecimalPlace > 0 Then
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
"00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
Temp = Getraos(Right(MyNumber, 3))
If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Dollars
Case ""
Dollars = "No Dollars"
Case "One"
Dollars = "One Dollar"
Case Else
Dollars = Dollars
End Select
Select Case Cents
Case ""
Cents = ""
Case "One"
Cents = " and One Cent"
Case Else
Cents = " and " & Cents & " Cents"
End Select
SpellNumber = Dollars & Cents
End Function
' Converts a number from 100-999 into text
Function Getraos(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
' Convert the raos place.
If Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & "ihvp"
End If
' Convert the tens and ones place.
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(MyNumber, 2))
Else
Result = Result & GetDigit(Mid(MyNumber, 3))
End If
Getraos = Result
End Function
' Converts a number from 10 to 99 into text.
Function GetTens(TensText)
Dim Result As String
Result = "" ' Null out the temporary function value.
If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
Select Case Val(TensText)
Case 10: Result = "ly["
Case 11: Result = "ly[gvaf"
Case 12: Result = "ly[lv'"
Case 13: Result = "ly[lk,"
Case 14: Result = "ly[luj"
Case 15: Result = "ly[shk"
Case 16: Result = "ly[sqd"
Case 17: Result = "ly[g9af"
Case 18: Result = "ly[cxf"
Case 19: Result = "ly[gdQk"
Case Else
End Select
Else ' If value between 20-99...
Select Case Val(Left(TensText, 1))
Case 2: Result = "-k;"
Case 3: Result = "lk,ly["
Case 4: Result = "lujly["
Case 5: Result = "shkly["
Case 6: Result = "sqdly["
Case 7: Result = "g9afly["
Case 8: Result = "cxfly["
Case 9: Result = "gdQkly["
Case Else
End Select
Result = Result & GetDigit _
(Right(TensText, 1)) ' Retrieve ones place.
End If
GetTens = Result
End Function
' Converts a number from 1 to 9 into text.
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "sobj'"
Case 2: GetDigit = "lv'"
Case 3: GetDigit = "lk,"
Case 4: GetDigit = "luj"
Case 5: GetDigit = "shk"
Case 6: GetDigit = "sqd"
Case 7: GetDigit = "g9af"
Case 8: GetDigit = "cxf"
Case 9: GetDigit = "gdQk"
Case Else: GetDigit = ""
End Select
End Function
วังวู ช่ง wrote: Fri Jan 01, 2021 5:36 pm...อยากถามที่ว่า เราเขียน VBA ภาษาลาวไม่ได้ อยากขอความช่วยเหลือด้วยครับ
ที่อาจารยถามนี้ ผมเองยังไม่รุ้ว่าจะแทนแบบไหนอย่างไรเลยคับ หรือ เป็นไทยแล้วแปลเป็นลาวใช้ไม่ครับอาจารย หรือ เขียน code ปรับเป็นลาวครับ
ออ ครับผม คงไม่ได้ครับอาจารย เพราะ เมื่อออกมาเป็นไทยแล้ว ใช้ font ไหนก็อเป็นภาษาไทยอยู่ครับsnasui wrote: Sun Jan 03, 2021 1:35 pmผมเข้าใจว่าใช้ภาษาไทยในการเขียน VBA ได้ครับ
เมื่อเขียน VBA ด้วยภาษาไทยได้ก็เขียนด้วยภาษาไทยได้เลย ส่วนการแสดงผลใน Worksheet ให้ใช้ Font ลาว
ใน Worksheet เราจะเลือกได้ว่าใช้ Font รูปแบบลาวหรือไทยหรืออื่น ๆ ครับ
Code: Select all
Option Explicit
'Main Function
Function SpellNumberTotext(ByVal MyNumber)
Dim Dollars, Cents, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = "rao"
Place(3) = "]hko"
Place(4) = "8N"
Place(5) = "rao8N"
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, ".")
' Convert cents and set MyNumber to dollar amount.
If DecimalPlace > 0 Then
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
"00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
Temp = Getraos(Right(MyNumber, 3))
If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Dollars
Case ""
Dollars = "[=j,u8q;g]d"
Case "One"
Dollars = "sobj'du[4h;o"
Case Else
Dollars = Dollars
End Select
Select Case Cents
Case ""
Cents = ""
Case "One"
Cents = ""
Case Else
Cents = " and " & Cents & " Cents"
End Select
SpellNumberTotext = Dollars & Cents
End Function
' Converts a number from 100-999 into text
Function Getraos(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
' Convert the raos place.
If Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & "Ihvp"
End If
' Convert the tens and ones place.
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(MyNumber, 2))
Else
Result = Result & GetDigit(Mid(MyNumber, 3))
End If
Getraos = Result
End Function
' Converts a number from 10 to 99 into text.
Function GetTens(TensText)
Dim Result As String
Result = "" ' Null out the temporary function value.
If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
Select Case Val(TensText)
Case 10: Result = "ly["
Case 11: Result = "ly[gvaf"
Case 12: Result = "ly[lv'"
Case 13: Result = "ly[lk,"
Case 14: Result = "ly[luj"
Case 15: Result = "ly[shk"
Case 16: Result = "ly[sqd"
Case 17: Result = "ly[g9af"
Case 18: Result = "ly[cxf"
Case 19: Result = "ly[gdQk"
Case Else
End Select
Else ' If value between 20-99...
Select Case Val(Left(TensText, 1))
Case 2: Result = "-k;"
Case 3: Result = "lk,ly["
Case 4: Result = "lujly["
Case 5: Result = "shkly["
Case 6: Result = "sqdly["
Case 7: Result = "g9afly["
Case 8: Result = "cxfly["
Case 9: Result = "gdQkly["
Case Else
End Select
Result = Result & GetDigit _
(Right(TensText, 1)) ' Retrieve ones place.
End If
If Val(Right(TensText, 1)) = 1 Then ' If value between 21-91...
Select Case Val(TensText)
Case 21: Result = "-k;gvaf"
Case 31: Result = "lk,ly[gvaf"
Case 41: Result = "lujly[gvaf"
Case 51: Result = "shkly[gvaf"
Case 61: Result = "sqdly[gvaf"
Case 71: Result = "g9afly[gvaf"
Case 81: Result = "cxfly[gvaf"
Case 91: Result = "gdqhkly[gvaf"
Case Else
End Select
End If
GetTens = Result
End Function
' Converts a number from 1 to 9 into text.
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "sobj'"
Case 2: GetDigit = "lv'"
Case 3: GetDigit = "lk,"
Case 4: GetDigit = "luj"
Case 5: GetDigit = "shk"
Case 6: GetDigit = "sqd"
Case 7: GetDigit = "g9af"
Case 8: GetDigit = "cxf"
Case 9: GetDigit = "gdQk"
Case Else: GetDigit = ""
End Select
End Function
snasui wrote: Sun Jan 03, 2021 1:54 pmแนบไฟล์ที่มี Code มาด้วยจะได้สะดวกในการตอบของเพื่อนสมาชิกครับ
Code: Select all
Option Explicit
'Main Function
Function SpellNumber(ByVal MyNumber)
Dim Bahts, Stangs, Temp1, Temp2
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " Lan "
Place(3) = " Lan "
Place(4) = " Lan "
Place(5) = " Lan "
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, ".")
' Convert Stangs and set MyNumber to Baht amount.
If DecimalPlace > 0 Then
Stangs = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
Temp1 = GetHundreds(Right(MyNumber, 3))
If Len(MyNumber) > 3 Then
Temp2 = GetHundreds1(Right(Left(MyNumber, Len(MyNumber) - 3), 3))
Else
Temp2 = ""
End If
If Temp1 <> "" Then Bahts = Temp1 & Place(Count) & Bahts
If Temp2 <> "" Then Bahts = Temp2 & Bahts
If Len(MyNumber) > 6 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 6)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Bahts
Case ""
Bahts = "Soon Bahts"
Case "Nueng"
Bahts = "Nueng Baht"
Case Else
If Right(Bahts, 6) = " Nueng" Then
Bahts = Replace(Bahts, " Nueng", " Ed") & " Bahts"
Else
Bahts = Bahts & " Bahts"
End If
End Select
Select Case Stangs
Case ""
Stangs = " Tuan"
Case "Nueng"
Stangs = " Nueng Stang"
Case Else
Stangs = " " & Stangs & " Stangs"
End Select
SpellNumber = Bahts & Stangs
End Function
' Converts a number from 100-999 into text
Function GetHundreds1(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
' Convert the hundreds place.
If Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & " San "
End If
' Convert the tens and ones place.
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & GetDigit(Mid(MyNumber, 2, 1)) & " Muen "
End If
If Mid(MyNumber, 3) <> "0" Then
Result = Result & GetDigit(Mid(MyNumber, 3)) & " Pan "
End If
GetHundreds1 = Result
End Function
' Converts a number from 100-999 into text
Function GetHundreds(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
' Convert the hundreds place.
If Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & " Roi "
End If
' Convert the tens and ones place.
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(MyNumber, 2))
Else
Result = Result & GetDigit(Mid(MyNumber, 3))
End If
GetHundreds = Result
End Function
' Converts a number from 10 to 99 into text.
Function GetTens(TensText)
Dim Result As String
Result = "" ' Null out the temporary function value.
If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
Select Case Val(TensText)
Case 10: Result = "Sib"
Case 11: Result = "Sib-ed"
Case 12: Result = "Sibsong"
Case 13: Result = "Sibsam"
Case 14: Result = "Sibsee"
Case 15: Result = "Sibha"
Case 16: Result = "Sibhok"
Case 17: Result = "Sibjed"
Case 18: Result = "Sibpad"
Case 19: Result = "Sibkao"
Case Else
End Select
Else ' If value between 20-99...
Select Case Val(Left(TensText, 1))
Case 2: Result = "Yeesib "
Case 3: Result = "Samsib "
Case 4: Result = "Seesib "
Case 5: Result = "Hasib "
Case 6: Result = "Hoksib "
Case 7: Result = "Jedsib "
Case 8: Result = "Padsib "
Case 9: Result = "Kaosib "
Case Else
End Select
Result = Result & GetDigit(Right(TensText, 1)) ' Retrieve ones place.
End If
GetTens = Result
End Function
' Converts a number from 1 to 9 into text.
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "Nueng"
Case 2: GetDigit = "Song"
Case 3: GetDigit = "Sam"
Case 4: GetDigit = "See"
Case 5: GetDigit = "Ha"
Case 6: GetDigit = "Hok"
Case 7: GetDigit = "Jed"
Case 8: GetDigit = "Pad"
Case 9: GetDigit = "Kao"
Case Else: GetDigit = ""
End Select
End Function
ตัวนี้คงผิดครับอาจารยหsnasui wrote: Sun Jan 03, 2021 6:55 pmผมปรับ Code เป็นภาษาคาราโอเกะให้แล้วตามด้านล่าง ลองนำไปปรับใช้ดูครับ
Code: Select all
Option Explicit 'Main Function Function SpellNumber(ByVal MyNumber) Dim Bahts, Stangs, Temp1, Temp2 Dim DecimalPlace, Count ReDim Place(9) As String Place(2) = " Lan " Place(3) = " Lan " Place(4) = " Lan " Place(5) = " Lan " ' String representation of amount. MyNumber = Trim(Str(MyNumber)) ' Position of decimal place 0 if none. DecimalPlace = InStr(MyNumber, ".") ' Convert Stangs and set MyNumber to Baht amount. If DecimalPlace > 0 Then Stangs = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)) MyNumber = Trim(Left(MyNumber, DecimalPlace - 1)) End If Count = 1 Do While MyNumber <> "" Temp1 = GetHundreds(Right(MyNumber, 3)) If Len(MyNumber) > 3 Then Temp2 = GetHundreds1(Right(Left(MyNumber, Len(MyNumber) - 3), 3)) Else Temp2 = "" End If If Temp1 <> "" Then Bahts = Temp1 & Place(Count) & Bahts If Temp2 <> "" Then Bahts = Temp2 & Bahts If Len(MyNumber) > 6 Then MyNumber = Left(MyNumber, Len(MyNumber) - 6) Else MyNumber = "" End If Count = Count + 1 Loop Select Case Bahts Case "" Bahts = "Soon Bahts" Case "Nueng" Bahts = "Nueng Baht" Case Else If Right(Bahts, 6) = " Nueng" Then Bahts = Replace(Bahts, " Nueng", " Ed") & " Bahts" Else Bahts = Bahts & " Bahts" End If End Select Select Case Stangs Case "" Stangs = " Tuan" Case "Nueng" Stangs = " Nueng Stang" Case Else Stangs = " " & Stangs & " Stangs" End Select SpellNumber = Bahts & Stangs End Function ' Converts a number from 100-999 into text Function GetHundreds1(ByVal MyNumber) Dim Result As String If Val(MyNumber) = 0 Then Exit Function MyNumber = Right("000" & MyNumber, 3) ' Convert the hundreds place. If Mid(MyNumber, 1, 1) <> "0" Then Result = GetDigit(Mid(MyNumber, 1, 1)) & " San " End If ' Convert the tens and ones place. If Mid(MyNumber, 2, 1) <> "0" Then Result = Result & GetDigit(Mid(MyNumber, 2, 1)) & " Muen " End If If Mid(MyNumber, 3) <> "0" Then Result = Result & GetDigit(Mid(MyNumber, 3)) & " Pan " End If GetHundreds1 = Result End Function ' Converts a number from 100-999 into text Function GetHundreds(ByVal MyNumber) Dim Result As String If Val(MyNumber) = 0 Then Exit Function MyNumber = Right("000" & MyNumber, 3) ' Convert the hundreds place. If Mid(MyNumber, 1, 1) <> "0" Then Result = GetDigit(Mid(MyNumber, 1, 1)) & " Roi " End If ' Convert the tens and ones place. If Mid(MyNumber, 2, 1) <> "0" Then Result = Result & GetTens(Mid(MyNumber, 2)) Else Result = Result & GetDigit(Mid(MyNumber, 3)) End If GetHundreds = Result End Function ' Converts a number from 10 to 99 into text. Function GetTens(TensText) Dim Result As String Result = "" ' Null out the temporary function value. If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19... Select Case Val(TensText) Case 10: Result = "Sib" Case 11: Result = "Sib-ed" Case 12: Result = "Sibsong" Case 13: Result = "Sibsam" Case 14: Result = "Sibsee" Case 15: Result = "Sibha" Case 16: Result = "Sibhok" Case 17: Result = "Sibjed" Case 18: Result = "Sibpad" Case 19: Result = "Sibkao" Case Else End Select Else ' If value between 20-99... Select Case Val(Left(TensText, 1)) Case 2: Result = "Yeesib " Case 3: Result = "Samsib " Case 4: Result = "Seesib " Case 5: Result = "Hasib " Case 6: Result = "Hoksib " Case 7: Result = "Jedsib " Case 8: Result = "Padsib " Case 9: Result = "Kaosib " Case Else End Select Result = Result & GetDigit(Right(TensText, 1)) ' Retrieve ones place. End If GetTens = Result End Function ' Converts a number from 1 to 9 into text. Function GetDigit(Digit) Select Case Val(Digit) Case 1: GetDigit = "Nueng" Case 2: GetDigit = "Song" Case 3: GetDigit = "Sam" Case 4: GetDigit = "See" Case 5: GetDigit = "Ha" Case 6: GetDigit = "Hok" Case 7: GetDigit = "Jed" Case 8: GetDigit = "Pad" Case 9: GetDigit = "Kao" Case Else: GetDigit = "" End Select End Function
Select Case Bahts เป็นด้านล่างครับCode: Select all
'Other code
Select Case Bahts
Case ""
Bahts = "Soon Bahts"
Case "Nueng"
Bahts = "Nueng Baht"
Case Else
If Right(Bahts, 6) = " Nueng" Then
Bahts = Left(Bahts, Len(Bahts) - 6) & " Ed Bahts"
Else
Bahts = Bahts & " Bahts"
End If
End Select
'Other code
ก็อใกล้จะใช้ได้แล้วครับอาจารย แต่บ่อนต่างกันเล็กน้อยไทย-ลาวนั้นอยู่ที่ว่าsnasui wrote: Sun Jan 03, 2021 10:15 pmปรับ Code ช่วง
Select Case Bahtsเป็นด้านล่างครับ
Code: Select all
'Other code Select Case Bahts Case "" Bahts = "Soon Bahts" Case "Nueng" Bahts = "Nueng Baht" Case Else If Right(Bahts, 6) = " Nueng" Then Bahts = Left(Bahts, Len(Bahts) - 6) & " Ed Bahts" Else Bahts = Bahts & " Bahts" End If End Select 'Other code
snasui wrote: Mon Jan 04, 2021 10:56 pmขอสอบถามเพิ่มเติมว่า
ตรงหลักพันหรือหลักอื่นใดก็ตาม เมื่อใดจะอ่านว่าเอ็ด เมื่อใดจะอ่านว่าหนึ่งครับ
หลักพันขื้นไป และ หลักสิบเชั่นว่า #1, #,100, #1,000, #10,000.........อ่านว่าเอ็ด ตัวอย่าง 11; 21; 2,100; 31,000; 510 ,000 อ่านว่า สิบเอ็ด, ชาวเอ็ด, สองพันเอ็ด, สามสิบเอ็ดพัน หรือ สามหมื่นเอ็ด, ห้าแสนเอ็ด หรือ ห้าแสนสิบพัน ถ้า 1 อยู่ท้าย และ ทางหน้าของ 1 เป็น 0 (สูน) อ่านว่าหนึ่ง ตัวอย่าง 101, 201............อ่านว่า หนึ่งร้อยหนึ่ง, สองร้อยหนึ่ง..........
กรณีที่หลักหมื่นเป็นเลข 2 เมื่อใดจะอ่านเป็นยี่สิบ เมื่อใดจะอ่านเป็นซาวครับ
ส่วนใหญ่จะอ่านว่าชาวครับ แต่จะอ่านว่าสองหมื่นก็อไม่ผิดครับอาจารย ตัวอย่าง 21,000 ส่วนมากจะอ่านว่า ชาวเอ็ดพัน แต่จะอ่านว่า สองหมื่นเอ็ดก็อไม่ผิด หรือ จะอ่านว่า สองหมื่นหนึ่งพัน ก็อไม่ผิดครับ แต่ที่อ่านมากที่สุดคือ ชาวเอ็ดพันครับ
และ 21,521 บาท อ่านว่า ชาวเอ็ดพันห้าร้อยชาวเอ็ด แต่เราจะอ่านว่า สองหมื่นหนึ่งพันห้าร้อยชาวเอ็ด ก็อไม่ผิดครับ
วังวู ช่ง wrote: Tue Jan 05, 2021 12:14 pm 21,000 ส่วนมากจะอ่านว่า ชาวเอ็ดพัน แต่จะอ่านว่า สองหมื่นเอ็ดก็อไม่ผิด หรือ จะอ่านว่า สองหมื่นหนึ่งพัน ก็ไม่ผิดครับ
Code: Select all
Result = Result & GetDigit(Mid(MyNumber, 2, 1)) & " Muen "Code: Select all
Result = Result & GetDigit(Mid(MyNumber, 2, 1)) & " Sib "