Nhờ cao thủ giúp đỡ sửa Code VBA. (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Status
Không mở trả lời sau này.

minh_trungtq

Thành viên mới
Tham gia
10/8/10
Bài viết
20
Được thích
0
mình tìm mãi trong diễn đàn không có code nào tự động đổi số thành chữ, toàn phải nhập bằng tay,
mình muốn nhờ anh chị sửa giúp code sau tự đổi số thành chữ nguồn chứa số ô A2 , Kết quả là chữ ở ô A3, giúp mình với.

Mã:
Public Function VND(BaoNhieu)
If Val(BaoNhieu) = 0 Then
Ketqua = "Khoâng ñoàng"
Else
If Abs(BaoNhieu) > 1E+15 Then
Ketqua = "Soá quaù lôùn"
Else
If BaoNhieu < 0 Then Ketqua = "Tröø" & Space(1) Else Ketqua = Space(0)
SOTIEN = Format(Abs(BaoNhieu), "###############0.00") '18coät soá 2soá leû
SOTIEN = Right(Space(15) & SOTIEN, 18)
Hang = Array("None", "traêm", "möôi", "gì ñoù")
DONVI = Array("None", "ngaøn tyû", "tyû", "trieäu", "ngaøn", "ñoàng", "xu")
Dem = Array("None", "moât", "hai", "ba", "boán", "naêm", "saùu", "baûy", "taùm", "chín")
For N = 1 To 6
Nhom = Mid(SOTIEN, N * 3 - 2, 3)
If Nhom <> Space(3) Then
Select Case Nhom
Case "000"
If N = 5 Then
Chu = "ñoàng" & Space(1)
Else
Chu = Space(0)
End If
Case ".00", ",00"
Chu = "chaün"
Case Else
S1 = Left(Nhom, 1): S2 = Mid(Nhom, 2, 1): S3 = Right(Nhom, 1)
Chu = Space(0): Hang(3) = DONVI(N)
For K = 1 To 3
Dich = Space(0): S = Val(Mid(Nhom, K, 1))
If S > 0 Then
Dich = Dem(S) & Space(1) & Hang(K) & Space(1)
Else
If K = 1 And N > 1 And N < 6 And Val(Mid(SOTIEN, (N - 1) * 3 - 2, 3)) > 0 Then
Dich = "khoâng" & Space(1) & Hang(K) & Space(1)
End If
End If
Select Case K
Case 2 And S = 1
Dich = "möôøi" & Space(1)
Case 3 And S = 0 And Nhom <> Space(2) & "0"
Dich = Hang(K) & Space(1)
Case 3 And S = 5 And Val(S2) > 2
Dich = "l" & Mid(Dich, 2)
Case 2 And S = 0 And S3 <> "0"
If N > 1 And Val(Mid(SOTIEN, (N - 1) * 3 - 2, 3)) > 0 Or (Val(S1) > 0) Then
Dich = "leû" & Space(1)
End If
End Select
Chu = Chu & Dich
Next K
End Select
ViTri = InStr(1, Chu, "möôi moät")
If ViTri > 0 Then Mid(Chu, ViTri, 9) = "möôi moát"
Ketqua = Ketqua & Chu
End If
Next N
End If
End If
VND = UCase(Left(Ketqua, 1)) & Trim(Mid(Ketqua, 2))
End Function

mong được anh chị giúp đỡ.
Trân trọng cảm ơn anh chị.
 

File đính kèm

mình tìm mãi trong diễn đàn không có code nào tự động đổi số thành chữ, toàn phải nhập bằng tay,
mình muốn nhờ anh chị sửa giúp code sau tự đổi số thành chữ nguồn chứa số ô A2 , Kết quả là chữ ở ô A3, giúp mình với.

Mã:
Public Function VND(BaoNhieu)
If Val(BaoNhieu) = 0 Then
Ketqua = "Khoâng ñoàng"
Else
If Abs(BaoNhieu) > 1E+15 Then
Ketqua = "Soá quaù lôùn"
Else
If BaoNhieu < 0 Then Ketqua = "Tröø" & Space(1) Else Ketqua = Space(0)
SOTIEN = Format(Abs(BaoNhieu), "###############0.00") '18coät soá 2soá leû
SOTIEN = Right(Space(15) & SOTIEN, 18)
Hang = Array("None", "traêm", "möôi", "gì ñoù")
DONVI = Array("None", "ngaøn tyû", "tyû", "trieäu", "ngaøn", "ñoàng", "xu")
Dem = Array("None", "moât", "hai", "ba", "boán", "naêm", "saùu", "baûy", "taùm", "chín")
For N = 1 To 6
Nhom = Mid(SOTIEN, N * 3 - 2, 3)
If Nhom <> Space(3) Then
Select Case Nhom
Case "000"
If N = 5 Then
Chu = "ñoàng" & Space(1)
Else
Chu = Space(0)
End If
Case ".00", ",00"
Chu = "chaün"
Case Else
S1 = Left(Nhom, 1): S2 = Mid(Nhom, 2, 1): S3 = Right(Nhom, 1)
Chu = Space(0): Hang(3) = DONVI(N)
For K = 1 To 3
Dich = Space(0): S = Val(Mid(Nhom, K, 1))
If S > 0 Then
Dich = Dem(S) & Space(1) & Hang(K) & Space(1)
Else
If K = 1 And N > 1 And N < 6 And Val(Mid(SOTIEN, (N - 1) * 3 - 2, 3)) > 0 Then
Dich = "khoâng" & Space(1) & Hang(K) & Space(1)
End If
End If
Select Case K
Case 2 And S = 1
Dich = "möôøi" & Space(1)
Case 3 And S = 0 And Nhom <> Space(2) & "0"
Dich = Hang(K) & Space(1)
Case 3 And S = 5 And Val(S2) > 2
Dich = "l" & Mid(Dich, 2)
Case 2 And S = 0 And S3 <> "0"
If N > 1 And Val(Mid(SOTIEN, (N - 1) * 3 - 2, 3)) > 0 Or (Val(S1) > 0) Then
Dich = "leû" & Space(1)
End If
End Select
Chu = Chu & Dich
Next K
End Select
ViTri = InStr(1, Chu, "möôi moät")
If ViTri > 0 Then Mid(Chu, ViTri, 9) = "möôi moát"
Ketqua = Ketqua & Chu
End If
Next N
End If
End If
VND = UCase(Left(Ketqua, 1)) & Trim(Mid(Ketqua, 2))
End Function

mong được anh chị giúp đỡ.
Trân trọng cảm ơn anh chị.

Bạn ạ, không có code nào làm đúng ý của bạn đâu. Có 1 triệu người thì 1 triệu nhu cầu khác nhau thì làm sao có code nào thỏa mãn tất cả?

Trong một bài khác bạn than rằng bạn phải nhập công thức ở A3: = xyz(A2)

Thế thì rõ ràng bạn đã có hàm chuyển số thành chữ xyz rồi. Công cụ đã có. Chỉ cần cái đầu chịu suy nghĩ thì làm được thôi.

Nếu là "tự động đổi số thành chữ" thì rõ ràng cái thao tác "tự động đổi số thành chữ" nó phải "tự" thực hiện khi giá trị ô A2 thay đổi, đúng không? Vì nếu không thì "nó" phải được thực hiện khi nào? Khi bạn gái nhắn tin, khi sếp gọi "lên thảm quì", khi kẻng nghỉ trưa? Vậy thì "chầu chực" khi nào A2 thay đổi thì gọi hàm xyz(A2) và kết quả trả về "nhét" vào A3. Thế thôi. Tất nhiên là "Chầu chực" trong Worksheet_Change. Và kiểm tra xem có phải A2 thay đổi không để quyết định.

Tất nhiên tôi hiểu là bạn có rất nhiều ô kiểu A2 vì nếu chỉ có mỗi một ô thôi thì nhập công thức cho A3 = xyz(A2) chứ ai lại đi viết code. Nếu các ô kiểu A2 nhiều và nằm không có "trật tự" thì việc kiểm tra trong Worksheet_Change rất phiền hà. Nhưng nếu chúng đều nằm vd. trong cột A thì code kiểm tra lại ngắn gọn rồi. Bạn không gửi tập tin của mình và tôi cũng không biết các ô kiểu A2 nó có nằm lộn xộn hay không nên tôi cũng chỉ "võ mồm" thế thôi. Tôi không làm cái mà bạn tự làm được.

Mà bạn đá đít cái hàm dùng mã VNI đi nhé. Thời buổi nào mà vẫn còn dùng VNI?

Xu hướng là chuyển sang Unicode. Ngay từ năm 2001 đã có TCVN 6909:2001 (bộ mã ký tự tiếng Việt 16-bit) và năm 2002 đã có 72 /2002/QĐ-TTg (QUYẾT ĐỊNH CỦA THỦ TƯỚNG CHÍNH PHỦ
Về việc thống nhất dùng bộ mã các ký tự chữ Việt theo tiêu chuẩn TCVN 6909:2001 trong trao đổi thông tin điện tử giữa các tổ chức của Đảng và Nhà nước)

http://vanban.moet.gov.vn/?page=1.15&script=viewdoc&view=16823&opt=brpage

Rồi

http://thuvienphapluat.vn/archive/Q...909-2001-trong-nganh-Thong-ke-vb13741t17.aspx

và rất rất nhiều thông tư ...

Thế mà hơn 10 năm sau vẫn có vị, cơ quan bám chặt VN3, VNI thì chả hiểu nổi các vị. Bó tay toàn tập.com
 
Upvote 0
Status
Không mở trả lời sau này.

Bài viết mới nhất

Back
Top Bottom