แปลงตัวเลขเงินบาท หลักล้านไม่ถูกต้อง


0 สมาชิก และ 1 บุคคลทั่วไป กำลังดูหัวข้อนี้

01 เม.ย. 65 , 17:14:45
อ่าน 342 ครั้ง

kunlek

ตัวเลข 1,032,500 บาท อ่านได้เป็น (หนึ่งล้านศูนย์แสนสามหมื่นสองพันห้าร้อยบาทถ้วน)  ผมต้องแก้โมดูลอย่างไรครับ

 

01 เม.ย. 65 , 18:56:18
ตอบกลับ #1

kunlek

: แปลงตัวเลขเงินบาท หลักล้านไม่ถูกต้อง
« ตอบกลับ #1 เมื่อ: 01 เม.ย. 65 , 18:56:18 »
Function DoBathString(Num As String)
'ต้องขอขอบคุณผู้ที่เขียนโปรแกรมนี้เผยแพร่ในการตอบคำถามใน Pantip.com
Dim numstring(10) As String
Dim million As Integer
Dim hundred_million As Integer
Dim ten_thousand As Integer
Dim thousand As Integer
Dim hundred As Integer
Dim ten As Integer
Dim onebath As Integer
Dim inputstring As String
Dim numLen As Integer
Dim a As String
Dim result As String
Dim bTen As Boolean

numstring(1) = "ศูนย์"
numstring(2) = "หนึ่ง"
numstring(3) = "สอง"
numstring(4) = "สาม"
numstring(5) = "สี่"
numstring(6) = "ห้า"
numstring(7) = "หก"
numstring(8) = "เจ็ด"
numstring(9) = "แปด"
numstring(10) = "เก้า"
inputstring = Format$(Num, "######0.00")
numLen = Len(inputstring)
If numLen >= 10 Then
a = Left$(inputstring, numLen - 9)
If Len(a) = 1 Then result = numstring(Val(a) + 1) + "ล้าน"
End If
If numLen >= 9 Then
a = Mid$(inputstring, numLen - 8, 1)
result = result + numstring(Val(a) + 1) + "แสน"
End If
If numLen >= 8 Then
a = Mid$(inputstring, numLen - 7, 1)
If Val(a) > 0 Then result = result + numstring(Val(a) + 1) + "หมื่น"
End If
If numLen >= 7 Then
a = Mid$(inputstring, numLen - 6, 1)
If Val(a) > 0 Then result = result + numstring(Val(a) + 1) + "พัน"
End If
If numLen >= 6 Then
a = Mid$(inputstring, numLen - 5, 1)
If Val(a) > 0 Then result = result + numstring(Val(a) + 1) + "ร้อย"
End If
If numLen >= 5 Then
bTen = True
a = Mid$(inputstring, numLen - 4, 1)
If Val(a) = 0 Then bTen = False
If Val(a) = 1 Then result = result + "สิบ"
If Val(a) = 2 Then result = result + "ยี่สิบ"
If Val(a) >= 3 Then result = result + numstring(Val(a) + 1) + "สิบ"
End If
If numLen >= 4 Then
a = Mid$(inputstring, numLen - 3, 1)
If Val(a) = 0 And Len(result) = 0 And Right$(inputstring, 2) = "00" Then result = "ศูนย์"
If Val(a) = 1 Then
If bTen = True Then result = result + "เอ็ด"
If bTen = False Then result = result + "หนึ่ง"
End If
If Val(a) >= 2 Then result = result + numstring(Val(a) + 1)
End If

a = Right$(inputstring, 2)
If a = "00" Then
result = result + "บาทถ้วน"
Else
bTen = True
If Len(result) > 0 Then result = result + "บาท"
If Val(Left$(a, 1)) = 0 Then bTen = False
If Val(Left$(a, 1)) = 1 Then result = result + "สิบ"
If Val(Left$(a, 1)) = 2 Then result = result + "ยี่สิบ"
If Val(Left$(a, 1)) >= 3 Then result = result + numstring(Val(Left$(a, 1)) + 1) + "สิบ"
If Val(Right$(a, 1)) = 1 Then
If bTen = True Then result = result + "เอ็ด"
If bTen = False Then result = result + "หนึ่ง"
End If
If Val(Right$(a, 1)) >= 2 Then result = result + numstring(Val(Right$(a, 1)) + 1)
result = result + "สตางค์"
End If
DoBathString = result
End Function

 

02 เม.ย. 65 , 08:11:00
ตอบกลับ #2

PNR

: แปลงตัวเลขเงินบาท หลักล้านไม่ถูกต้อง
« ตอบกลับ #2 เมื่อ: 02 เม.ย. 65 , 08:11:00 »
เพิมเงื่อนไข นิดหน่อยก็ได้เลยครับ

Option Compare Database

Function DoBathString(Num As String)
'ต้องขอขอบคุณผู้ที่เขียนโปรแกรมนี้เผยแพร่ในการตอบคำถามใน Pantip.com
Dim numstring(10) As String
Dim million As Integer
Dim hundred_million As Integer
Dim ten_thousand As Integer
Dim thousand As Integer
Dim hundred As Integer
Dim ten As Integer
Dim onebath As Integer
Dim inputstring As String
Dim numLen As Integer
Dim a As String
Dim result As String
Dim bTen As Boolean

numstring(1) = "ศูนย์"
numstring(2) = "หนึ่ง"
numstring(3) = "สอง"
numstring(4) = "สาม"
numstring(5) = "สี่"
numstring(6) = "ห้า"
numstring(7) = "หก"
numstring(8) = "เจ็ด"
numstring(9) = "แปด"
numstring(10) = "เก้า"
inputstring = Format$(Num, "######0.00")
numLen = Len(inputstring)
If numLen >= 10 Then
a = Left$(inputstring, numLen - 9)
If Len(a) = 1 Then result = numstring(Val(a) + 1) + "ล้าน"
End If
If numLen >= 9 Then
a = Mid$(inputstring, numLen - 8, 1)
If Val(a) > 0 Then result = result + numstring(Val(a) + 1) + "แสน"
End If
If numLen >= 8 Then
a = Mid$(inputstring, numLen - 7, 1)
If Val(a) > 0 Then result = result + numstring(Val(a) + 1) + "หมื่น"
End If
If numLen >= 7 Then
a = Mid$(inputstring, numLen - 6, 1)
If Val(a) > 0 Then result = result + numstring(Val(a) + 1) + "พัน"
End If
If numLen >= 6 Then
a = Mid$(inputstring, numLen - 5, 1)
If Val(a) > 0 Then result = result + numstring(Val(a) + 1) + "ร้อย"
End If
If numLen >= 5 Then
bTen = True
a = Mid$(inputstring, numLen - 4, 1)
If Val(a) = 0 Then bTen = False
If Val(a) = 1 Then result = result + "สิบ"
If Val(a) = 2 Then result = result + "ยี่สิบ"
If Val(a) >= 3 Then result = result + numstring(Val(a) + 1) + "สิบ"
End If
If numLen >= 4 Then
a = Mid$(inputstring, numLen - 3, 1)
If Val(a) = 0 And Len(result) = 0 And Right$(inputstring, 2) = "00" Then result = "ศูนย์"
If Val(a) = 1 Then
If bTen = True Then result = result + "เอ็ด"
If bTen = False Then result = result + "หนึ่ง"
End If
If Val(a) >= 2 Then result = result + numstring(Val(a) + 1)
End If

a = Right$(inputstring, 2)
If a = "00" Then
result = result + "บาทถ้วน"
Else
bTen = True
If Len(result) > 0 Then result = result + "บาท"
If Val(Left$(a, 1)) = 0 Then bTen = False
If Val(Left$(a, 1)) = 1 Then result = result + "สิบ"
If Val(Left$(a, 1)) = 2 Then result = result + "ยี่สิบ"
If Val(Left$(a, 1)) >= 3 Then result = result + numstring(Val(Left$(a, 1)) + 1) + "สิบ"
If Val(Right$(a, 1)) = 1 Then
If bTen = True Then result = result + "เอ็ด"
If bTen = False Then result = result + "หนึ่ง"
End If
If Val(Right$(a, 1)) >= 2 Then result = result + numstring(Val(Right$(a, 1)) + 1)
result = result + "สตางค์"
End If
DoBathString = result
End Function

« แก้ไขครั้งสุดท้าย: 02 เม.ย. 65 , 12:01:59 โดย PNR »
Time to stop for me  :dizzy:
 

02 เม.ย. 65 , 13:37:03
ตอบกลับ #3

UnKnown

: แปลงตัวเลขเงินบาท หลักล้านไม่ถูกต้อง
« ตอบกลับ #3 เมื่อ: 02 เม.ย. 65 , 13:37:03 »
โมดูลที่ผมใช้
โค๊ด: [Select]
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

« แก้ไขครั้งสุดท้าย: 02 เม.ย. 65 , 13:49:08 โดย UnKnown »
:ninja:     ลองคิด,ลองทำแนวคนไม่เก่งแอคเซส
หมายเหตุ เพื่อความปลอดภัยโปรดสำรองข้อมูลใว้ก่อนการแก้ไข
 

03 เม.ย. 65 , 16:48:34
ตอบกลับ #4

kunlek

: แปลงตัวเลขเงินบาท หลักล้านไม่ถูกต้อง
« ตอบกลับ #4 เมื่อ: 03 เม.ย. 65 , 16:48:34 »
ขอบคุณครับท่าน

 

05 เม.ย. 65 , 10:53:00
ตอบกลับ #5

nonc31

: แปลงตัวเลขเงินบาท หลักล้านไม่ถูกต้อง
« ตอบกลับ #5 เมื่อ: 05 เม.ย. 65 , 10:53:00 »
อ่านได้เป็น แสนล้าน

 
โพสต์นี้ได้รับคำขอบคุณจาก: PNR


บอร์ดเรียนรู้ Access สำหรับคนไทย