Giúp tôi với, tôi không sửa được đoạn VBA dịch số ra chữ này

  • Thread starter thenambgi
  • Ngày gửi
T

thenambgi

Guest
14/8/06
2
0
0
Bắc Giang
Tôi tìm được một đoạn mã dịch số ra chữ bằng VBA dùng trong Excel, biến nó thành có thể dịch số ra chữ theo cách của mình, tuy nhiên tôi không thể sửa được đoạn "mươi mốt" và "mười một". Các U giúp tôi ngay ha. Cảm ơn nhiều.

Public Function bangchu(sotien)
If Val(sotien) = 0 Then
ketqua = "Không đồng"
Else
tien = Format(Round(Abs(sotien), 0), "##############0.00")
tien = Right(Space(15) & tien, 18)
hang = Array(" ", "trăm", "mươi", " ")
donvi = Array(" ", "triệu tỷ", "ngàn tỷ", "tỷ", "triệu", "ngàn đồng", " ")
dem = Array(" ", "một", "hai", "ba", "bốn", "năm", "sáu", "bảy", "tám", "chín")
For n = 1 To 6
nhom = Mid(tien, n * 3 - 2, 3)
If nhom <> Space(3) Then
Select Case nhom
Case "000"
If n = 5 Then
chu = "đồng" & " "
Else
chu = ""
End If
'Case ".00", ",00"
'chu = "chẵn"
Case Else
s1 = Left(nhom, 1): s2 = Mid(nhom, 2, 1): s3 = Right(nhom, 1)
chu = "": hang(3) = donvi(n)
For k = 1 To 3
dich = "": s = Val(Mid(nhom, k, 1))
If s > 0 Then
dich = dem(s) & " " & hang(k) & " "
Else
If k = 1 And n > 1 And n < 6 And Val(Mid(tien, (n - 1) * 3 - 2, 3)) > 0 Then
dich = "không" & " " & hang(k) & " "
End If
End If
Select Case k
Case 2 And s = 1
dich = "m­ười" & " "
Case 3 And s = 0 And nhom <> " " & "0"
dich = hang(k) & " "
Case 3 And s = 5 And Val(s2) > 0
dich = "l" & Mid(dich, 2)
Case 2 And s = 0 And s3 <> "0"
If n > 1 And Val(Mid(tien, (n - 1) * 3 - 2, 3)) > 0 Or (Val(s1) > 0) Then
dich = "lẻ" & " "
End If
End Select
chu = chu & dich
Next k
End Select
vitri = InStr(1, chu, "m­ươi mốt")
If vitri > 0 Then Mid(chu, vitri, 9) = "mười một"
ketqua = ketqua & chu
End If
Next n
End If
If sotien < 0 Then
bangchu = "Bằng chữ: " & "Âm " & Left(ketqua, 1) & Trim(Mid(ketqua, 2))
Else
bangchu = "Bằng chữ: " & UCase(Left(ketqua, 1)) & Trim(Mid(ketqua, 2))
End If
End Function

CẢM ƠN CÁC U NHIỀU !!!
 
Khóa học Quản trị dòng tiền

Xem nhiều

Webketoan Zalo OA