กระทู้เก่าบอร์ด อ.Yeadram
5,462 6
URL.หัวข้อ /
URL
แปลงตัวเลขเป็นตัวอักษรมีปัญหาที่หลักหน่วยครับ
ผมก๊อปปี้ใช้สูตรตามด้านล่างนี้แล้วทำไม ที่หลักหน่วยถึงมีปัญหาตามนี้ครับ 19,901 บาท อ่านเป็น "หนึ่งหมื่นเก้าพันเก้าร้อยเอ็ดบาทถ้วน" ทำไมไม่อ่านเป็น "หนึ่งหมื่นเก้าพันเก้าร้อยหนึ่งบาทถ้วน" ล่ะครับ แต่ถ้าเป็น 19,902 บาท มันจะอ่านได้เป็น 'หนึ่งหมื่นเก้าพันเก้าร้อยสองบาทถ้วนครับ"
Function BahtText(ByVal sNum)
Dim sNumber , sDigit , sDigit10
Dim nLen , sWord , sWord2
Dim sByte , I , J
sNumber = Array("", "หนึ่ง", "สอง", "สาม", "สี่", "ห้า", "หก", "เจ็ด", "แปด", "เก้า")
sDigit = Array("", "สิบ", "ร้อย", "พัน", "หมื่น", "แสน")
sDigit10 = Array("", "สิบ", "ยี่สิบ", "สามสิบ", "สี่สิบ", "ห้าสิบ", "หกสิบ", "เจ็ดสิบ", "แปดสิบ", "เก้าสิบ")
sNum = Replace(FormatNumber(sNum, 2), ",", "")
nLen = Len(sNum)
If sNum = ".00" Then BahtText = "ศูนย์"
For I = 1 To nLen - 3
J = (15 + nLen - I) Mod 6
sByte = Mid(sNum, I, 1)
If sByte <> "0" Then
If J = 1 Then sWord = sDigit10(sByte) Else sWord = sNumber(sByte) & sDigit(J)
BahtText = BahtText & sWord
End If
If J = 0 And I <> nLen - 3 Then BahtText = BahtText & "ล้าน": BahtText = Replace(BahtText, "หนึ่งล้าน", "เอ็ดล้าน")
Next
If Left(sNum, 1) = "1" Then BahtText = Replace(BahtText, "เอ็ดล้าน", "หนึ่งล้าน")
If Left(sNum, 2) = "11" Then BahtText = Replace(BahtText, "สิบหนึ่งล้าน", "สิบเอ็ดล้าน")
If Len(BahtText) > 0 Then BahtText = BahtText & "บาท"
If nLen > 4 Then BahtText = Replace(BahtText, "หนึ่งบาท", "เอ็ดบาท")
sNum = Right(sNum, 2)
If sNum = "00" Then
BahtText = BahtText & "ถ้วน"
Else
If Left(sNum, 1) <> "0" Then BahtText = BahtText & sDigit10(Left(sNum, 1))
If Right(sNum, 1) <> "0" Then BahtText = BahtText & sNumber(Right(sNum, 1))
BahtText = BahtText & "สตางค์"
If Left(sNum, 1) <> "0" Then BahtText = Replace(BahtText, "หนึ่งสตางค์", "เอ็ดสตางค์")
End If
End Function
Function BahtText(ByVal sNum)
Dim sNumber , sDigit , sDigit10
Dim nLen , sWord , sWord2
Dim sByte , I , J
sNumber = Array("", "หนึ่ง", "สอง", "สาม", "สี่", "ห้า", "หก", "เจ็ด", "แปด", "เก้า")
sDigit = Array("", "สิบ", "ร้อย", "พัน", "หมื่น", "แสน")
sDigit10 = Array("", "สิบ", "ยี่สิบ", "สามสิบ", "สี่สิบ", "ห้าสิบ", "หกสิบ", "เจ็ดสิบ", "แปดสิบ", "เก้าสิบ")
sNum = Replace(FormatNumber(sNum, 2), ",", "")
nLen = Len(sNum)
If sNum = ".00" Then BahtText = "ศูนย์"
For I = 1 To nLen - 3
J = (15 + nLen - I) Mod 6
sByte = Mid(sNum, I, 1)
If sByte <> "0" Then
If J = 1 Then sWord = sDigit10(sByte) Else sWord = sNumber(sByte) & sDigit(J)
BahtText = BahtText & sWord
End If
If J = 0 And I <> nLen - 3 Then BahtText = BahtText & "ล้าน": BahtText = Replace(BahtText, "หนึ่งล้าน", "เอ็ดล้าน")
Next
If Left(sNum, 1) = "1" Then BahtText = Replace(BahtText, "เอ็ดล้าน", "หนึ่งล้าน")
If Left(sNum, 2) = "11" Then BahtText = Replace(BahtText, "สิบหนึ่งล้าน", "สิบเอ็ดล้าน")
If Len(BahtText) > 0 Then BahtText = BahtText & "บาท"
If nLen > 4 Then BahtText = Replace(BahtText, "หนึ่งบาท", "เอ็ดบาท")
sNum = Right(sNum, 2)
If sNum = "00" Then
BahtText = BahtText & "ถ้วน"
Else
If Left(sNum, 1) <> "0" Then BahtText = BahtText & sDigit10(Left(sNum, 1))
If Right(sNum, 1) <> "0" Then BahtText = BahtText & sNumber(Right(sNum, 1))
BahtText = BahtText & "สตางค์"
If Left(sNum, 1) <> "0" Then BahtText = Replace(BahtText, "หนึ่งสตางค์", "เอ็ดสตางค์")
End If
End Function
6 Reply in this Topic. Dispaly 1 pages and you are on page number 1
2 @R11726
อ้าว เหมือนกันนิ แต่ผมใช้แล้วใช้ได้นะครับ เกิดจากอะไร???
3 @R11727
เข้าใจว่า คุณอยากให้จำนวนเต็มที่ลงท้ายด้วย 01 อ่านเป็น หนึ่ง แทน เอ็ด ก็สามารถทำได้นะครับ แต่ตามมาตรฐาน ดูจาก Function ใน Excel เค้าก็อ่าน 101 เป็น หนึ่งร้อยเอ็ด ไม่ได้อ่านว่า หนึ่งร้อยหนึ่ง
แต่ถ้าอยากให้เป็นอย่างที่ว่า ใน Function เดิม ลองเปลี่ยนบรรทัด
If nLen > 4 Then BahtText = Replace(BahtText, "หนึ่งบาท", "เอ็ดบาท")
เป็น
If nLen > 4 And Not Right(sNum, 5) Like "01." & "*" Then BahtText = Replace(BahtText, "หนึ่งบาท", "เอ็ดบาท")
แนวๆนี้!!!
แต่ถ้าอยากให้เป็นอย่างที่ว่า ใน Function เดิม ลองเปลี่ยนบรรทัด
If nLen > 4 Then BahtText = Replace(BahtText, "หนึ่งบาท", "เอ็ดบาท")
เป็น
If nLen > 4 And Not Right(sNum, 5) Like "01." & "*" Then BahtText = Replace(BahtText, "หนึ่งบาท", "เอ็ดบาท")
แนวๆนี้!!!
4 @R11742
แก้จาก
If nLen > 4 Then BahtText = Replace(BahtText, "หนึ่งบาท", "เอ็ดบาท")
เป็น
If nLen > 4 Then BahtText = Replace(BahtText, "สิบหนึ่งบาท", "สิบเอ็ดบาท")
แต่ยังไม่ได้ทดสอบทุกกรณีนะครับ ลองไปทดสอบเองอีกครั้ง
If nLen > 4 Then BahtText = Replace(BahtText, "หนึ่งบาท", "เอ็ดบาท")
เป็น
If nLen > 4 Then BahtText = Replace(BahtText, "สิบหนึ่งบาท", "สิบเอ็ดบาท")
แต่ยังไม่ได้ทดสอบทุกกรณีนะครับ ลองไปทดสอบเองอีกครั้ง
5 @R20129
รบกวนช่อวยอธิบายวิธี แก้ บรรทัดนั้น ให้ทีได้มั้ยคะ เจอปัญหาเหมือนกัน ถ้าจำนวนเงิน ลงท้าย 01 ต้องพิมเองตลอดเลย
ขอบคุณล่วงหน้านะคะ
ขอบคุณล่วงหน้านะคะ
6 @R20132
หมายถึงยังไงครับ "วิธีแก้บรรทัดนั้น"
Time: 0.3278s
Function BahtText(ByVal sNum)
Dim sNumber , sDigit , sDigit10
Dim nLen , sWord , sWord2
Dim sByte , I , J
sNumber = Array("", "หนึ่ง", "สอง", "สาม", "สี่", "ห้า", "หก", "เจ็ด", "แปด", "เก้า")
sDigit = Array("", "สิบ", "ร้อย", "พัน", "หมื่น", "แสน")
sDigit10 = Array("", "สิบ", "ยี่สิบ", "สามสิบ", "สี่สิบ", "ห้าสิบ", "หกสิบ", "เจ็ดสิบ", "แปดสิบ", "เก้าสิบ")
sNum = Replace(FormatNumber(sNum, 2), ",", "")
nLen = Len(sNum)
If sNum = ".00" Then BahtText = "ศูนย์"
For I = 1 To nLen - 3
J = (15 + nLen - I) Mod 6
sByte = Mid(sNum, I, 1)
If sByte <> "0" Then
If J = 1 Then sWord = sDigit10(sByte) Else sWord = sNumber(sByte) & sDigit(J)
BahtText = BahtText & sWord
End If
If J = 0 And I <> nLen - 3 Then BahtText = BahtText & "ล้าน": BahtText = Replace(BahtText, "หนึ่งล้าน", "เอ็ดล้าน")
Next
If Left(sNum, 1) = "1" Then BahtText = Replace(BahtText, "เอ็ดล้าน", "หนึ่งล้าน")
If Left(sNum, 2) = "11" Then BahtText = Replace(BahtText, "สิบหนึ่งล้าน", "สิบเอ็ดล้าน")
If Len(BahtText) > 0 Then BahtText = BahtText & "บาท"
If nLen > 4 Then BahtText = Replace(BahtText, "หนึ่งบาท", "เอ็ดบาท")
sNum = Right(sNum, 2)
If sNum = "00" Then
BahtText = BahtText & "ถ้วน"
Else
If Left(sNum, 1) <> "0" Then BahtText = BahtText & sDigit10(Left(sNum, 1))
If Right(sNum, 1) <> "0" Then BahtText = BahtText & sNumber(Right(sNum, 1))
BahtText = BahtText & "สตางค์"
If Left(sNum, 1) <> "0" Then BahtText = Replace(BahtText, "หนึ่งสตางค์", "เอ็ดสตางค์")
End If
End Function
รูปแบบการใช้ในฟอร์ม
=BahtText([Text0])