Lấy dữ liệu vào mẫu có sẵn bằng VBA

Liên hệ QC
T

thao nguyen01

Thành viên thường trực
Tham gia
8/12/19
Bài viết
214
Được thích
25
Kính gửi anh/chị trên diễn đàn,

Em có vấn đề sau ạ: Em muốn lấy dữ liệu theo mã từ sheet data vào sheet biên bản theo mẫu ạ
1. Em cài đọc số tiền bằng chữ để đọc bên sheet data nhưng khi cài xong thì báo lỗi phiên bản ạ. Anh/chị có code VBA đọc số tiền bằng chữ giúp em với ạ.
2. Em muốn khi lấy dữ liệu sẽ điền vào biên bản như trong file ạ. Hiện giờ em làm vẫn chưa được ạ.

Anh/chị xem giúp em ạ. Em cảm ơn anh/chị nhiều ạ.
 

File đính kèm

  • file.xlsb
    16.1 KB · Đọc: 12
Sắp xếp theo thời gian sắp xếp theo bầu chọn
thao nguyen01 đã viết:
Kính gửi anh/chị trên diễn đàn,
Em có vấn đề sau ạ: Em muốn lấy dữ liệu theo mã từ sheet data vào sheet biên bản theo mẫu ạ
1. Em cài đọc số tiền bằng chữ để đọc bên sheet data nhưng khi cài xong thì báo lỗi phiên bản ạ. Anh/chị có code VBA đọc số tiền bằng chữ giúp em với ạ.
2. Em muốn khi lấy dữ liệu sẽ điền vào biên bản như trong file ạ. Hiện giờ em làm vẫn chưa được ạ.
Anh/chị xem giúp em ạ. Em cảm ơn anh/chị nhiều ạ.
Nhấp chuột vào đây để mở rộng...
1/ Phần cài đặt đọc số bằng chữ thì bạn có thể cài lại phiên bản khác, rất nhiều mà.
2/ Biên bản của bạn thiết kế không ổn, chắc bạn tự nghĩ ra, những đoạn bôi đỏ nên để riêng từng ô chứ gộp hết vào một ô thế này thì chỉ có giải pháp duy nhất là nhập tay. bạn nên điều chỉnh lại đã nhé.
 
Upvote 0
Hàm DongVN này có thể giúp bạn đọc con số 612.545.001.051.005 thành: Sáu trăm mười hai ngàn, năm trăm bốn mươi lăm tỷ, không trăm lẻ một triệu, không trăm năm mươi mốt ngàn, không trăm lẻ năm đồng chẵn.

Bạn thấy chỗ nào không đúng theo cách đọc mong muốn của bạn thì nói tôi đổi lại, ví dụ "lẻ một" thành "linh một"
Rich (BB code): 
Function vndFix(ByVal NumCurrency As Currency) As String
Static CharVND(9) As String, BangChu As String, i As Integer
Dim SoLe, SoDoi As Integer, PhanChan, Ten As String
Dim DonViTien As String, DonViLe As String
Dim NganTy As Integer, Ty As Integer, Trieu As Integer, Ngan As Integer
Dim Dong As Integer, Tram As Integer, Muoi As Integer, DonVi As Integer
DonViTien = ChrW(273) & ChrW(7891) & "ng" ' dong
DonViLe = "xu" ' xu
If NumCurrency = 0 Then
vndFix = "Không " & DonViTien
Exit Function
End If
If NumCurrency > 922337203685477# Then ' So lon nhat cua loai CURRENCY
vndFix = "Không " & ChrW(273) & ChrW(7893) & "i " & ChrW(273) & ChrW(432) _
& ChrW(7907) & "c s" & ChrW(7889) & " l" & ChrW(7899) & "n h" & ChrW(417) & "n 922.337.203.685.477"
Exit Function
End If
CharVND(1) = "m" & ChrW(7897) & "t" ' mot
CharVND(2) = "hai" ' hai
CharVND(3) = "ba" ' ba
CharVND(4) = "b" & ChrW(7889) & "n" ' bon
CharVND(5) = "n" & ChrW(259) & "m" ' nam
CharVND(6) = "sáu" ' sáu
CharVND(7) = "b" & ChrW(7843) & "y" ' bay
CharVND(8) = "tám" ' tám
CharVND(9) = "chín" ' chín
SoLe = Int((NumCurrency - Int(NumCurrency)) * 100) ' 2 kí s?
PhanChan = Trim$(Str$(Int(NumCurrency)))
PhanChan = Space(15 - Len(PhanChan)) + PhanChan
NganTy = Val(Left(PhanChan, 3))
Ty = Val(Mid$(PhanChan, 4, 3))
Trieu = Val(Mid$(PhanChan, 7, 3))
Ngan = Val(Mid$(PhanChan, 10, 3))
Dong = Val(Mid$(PhanChan, 13, 3))
If NganTy = 0 And Ty = 0 And Trieu = 0 And Ngan = 0 And Dong = 0 Then
BangChu = "không " + DonViTien + " "
i = 5
Else
BangChu = ""
i = 0
End If

'-----------------------------------------------------
While i <= 5
Select Case i
Case 0
SoDoi = NganTy
'Ten = "ngàn t" & ChrW(7927) ' ngàn ty
Ten = "ngàn"  ' ngàn ty
Case 1
SoDoi = Ty
Ten = "t" & ChrW(7927) ' ty
Case 2
SoDoi = Trieu
Ten = "tri" & ChrW(7879) & "u" ' trieu
Case 3
SoDoi = Ngan
Ten = "ngàn" ' ngàn
Case 4
SoDoi = Dong
Ten = DonViTien ' dong
Case 5
SoDoi = SoLe
Ten = DonViLe ' xu
End Select
If SoDoi <> 0 Then
    Tram = Int(SoDoi / 100)
    Muoi = Int((SoDoi - Tram * 100) / 10)
    DonVi = (SoDoi - Tram * 100) - Muoi * 10
    If Right(BangChu, 3) = " " Then
        BangChu = Left(BangChu, Len(BangChu) - 3)
    End If
    BangChu = BangChu + IIf(Len(BangChu) = 0, "", ", ") + _
    IIf(Tram <> 0, Trim(CharVND(Tram)) + " tr" & ChrW(259) & "m ", "")  '""
    If Muoi = 0 And Tram <> 0 And DonVi <> 0 Then
        BangChu = BangChu + "l" & ChrW(7867) & " "
    Else
        If Muoi <> 0 Then
            BangChu = BangChu + IIf(Muoi <> 0 And Muoi <> 1, _
            Trim(CharVND(Muoi)) + " m" & ChrW(432) & ChrW(417) & "i ", "m" & ChrW(432) & ChrW(7901) & "i ") 'muoi, mu+o+i`
        End If
    End If

    If Muoi <> 0 And DonVi = 5 Then
        BangChu = BangChu + "l" & ChrW(259) & "m " + Ten + " " 'la(m
    Else
        If Muoi > 1 And DonVi = 1 Then
            BangChu = BangChu + "m" & ChrW(7889) & "t " + Ten + " "  'Mo^/t
        Else
            BangChu = BangChu + IIf(DonVi <> 0, Trim(CharVND(DonVi)) + " " + Ten, Ten) + " "
        End If
    End If
Else
    BangChu = BangChu + IIf(i = 4, DonViTien + "", "")
End If
i = i + 1
Wend
If SoLe = 0 Then
BangChu = BangChu + IIf(Right(BangChu, 3) = " ", "", "") + " ch" & ChrW(7861) & "n" 'Cha(~n
End If
BangChu = Replace(BangChu, " ,", ",")
BangChu = Replace(BangChu, "  ", " ")
BangChu = UCase(Left(BangChu, 1)) + Right(BangChu, Len(BangChu) - 1)
vndFix = BangChu
End Function

'
Function DongVN(Num As Currency) As String
Dim arr, PhanChan
Dim VT As Integer, VT1 As Integer, VT2 As Integer, i As Integer, j As Integer, dem As Integer, Nhom As Integer
Dim NganTy As Integer, Ty As Integer, Trieu As Integer, Ngan As Integer
Dim Dong As Integer
Dim Chu As String, Chu2 As String, Chu3 As String

Chu = vndFix(Num)
PhanChan = Trim$(Str$(Int(Num)))
PhanChan = Space(15 - Len(PhanChan)) + PhanChan

NganTy = Val(Left(PhanChan, 3))
Ty = Val(Mid$(PhanChan, 4, 3))
Trieu = Val(Mid$(PhanChan, 7, 3))
Ngan = Val(Mid$(PhanChan, 10, 3))
Dong = Val(Mid$(PhanChan, 13, 3))
arr = Array(NganTy, Ty, Trieu, Ngan, Dong)
For i = 0 To 4
    If Val(arr(i)) <> 0 Then
        Nhom = Nhom + 1
    End If
Next
    
    VT = InStr(1, Chu, ",")
    If VT > 0 Then
        Chu2 = Mid(Chu, 1, VT - 1)
    Else
        Chu2 = Chu
    End If
    If Nhom = 5 Then
        Chu2 = Left(Chu2, Len(Chu2))
    End If
For i = (5 - Nhom + 1) To 4
    For j = 1 To i
        If j = i - 1 Then
            VT1 = InStr(VT1 + 1, Chu, ",")
        ElseIf j = i Then
            If Nhom = 5 And i = 1 Then
                VT1 = InStr(VT1 + 1, Chu, ",")
                VT2 = InStr(VT1 + 1, Chu, ",")
            Else
                VT2 = InStr(VT1 + 1, Chu, ",")
            End If
        End If
    Next
    If VT2 = 0 Then VT2 = Len(Chu) + 1
    If Len(Trim(arr(i))) = 3 Then
        Chu2 = Chu2 + ", " + Trim(Mid(Chu, VT1 + 1, VT2 - VT1 - 1))
    ElseIf Len(Trim(arr(i))) = 2 Then
        Chu2 = Chu2 + "," + " không tr" & ChrW(259) & "m " + Trim(Mid(Chu, VT1 + 1, VT2 - VT1 - 1))
    ElseIf Len(Trim(arr(i))) = 1 Then
        Chu2 = Chu2 + "," + " không tr" & ChrW(259) + "m l" & ChrW(7867) & " " + Trim(Mid(Chu, VT1 + 1, VT2 - VT1 - 1))
    End If
Next
    DongVN = Chu2
End Function
 
Lần chỉnh sửa cuối:
Upvote 0
Maika8008 đã viết:
Hàm DongVN này có thể giúp bạn đọc con số 612.545.001.051.005 thành: Sáu trăm mười hai ngàn, năm trăm bốn mươi lăm tỷ, không trăm lẻ một triệu, không trăm năm mươi mốt ngàn, không trăm lẻ năm đồng chẵn.

Bạn thấy chỗ nào không đúng theo cách đọc mong muốn của bạn thì nói tôi đổi lại, ví dụ "lẻ một" thành "linh một"
Rich (BB code): 
Function vnd (ByVal NumCurrency As Currency) As String
Static CharVND(9) As String, BangChu As String, i As Integer
Dim SoLe, SoDoi As Integer, PhanChan, Ten As String
Dim DonViTien As String, DonViLe As String
Dim NganTy As Integer, Ty As Integer, Trieu As Integer, Ngan As Integer
Dim Dong As Integer, Tram As Integer, Muoi As Integer, DonVi As Integer
DonViTien = ChrW(273) & ChrW(7891) & "ng" ' dong
DonViLe = "xu" ' xu
If NumCurrency = 0 Then
vndFix = "Không " & DonViTien
Exit Function
End If
If NumCurrency > 922337203685477# Then ' So lon nhat cua loai CURRENCY
vndFix = "Không " & ChrW(273) & ChrW(7893) & "i " & ChrW(273) & ChrW(432) _
& ChrW(7907) & "c s" & ChrW(7889) & " l" & ChrW(7899) & "n h" & ChrW(417) & "n 922.337.203.685.477"
Exit Function
End If
CharVND(1) = "m" & ChrW(7897) & "t" ' mot
CharVND(2) = "hai" ' hai
CharVND(3) = "ba" ' ba
CharVND(4) = "b" & ChrW(7889) & "n" ' bon
CharVND(5) = "n" & ChrW(259) & "m" ' nam
CharVND(6) = "sáu" ' sáu
CharVND(7) = "b" & ChrW(7843) & "y" ' bay
CharVND(8) = "tám" ' tám
CharVND(9) = "chín" ' chín
SoLe = Int((NumCurrency - Int(NumCurrency)) * 100) ' 2 kí s?
PhanChan = Trim$(str$(Int(NumCurrency)))
PhanChan = Space(15 - Len(PhanChan)) + PhanChan
NganTy = Val(Left(PhanChan, 3))
Ty = Val(Mid$(PhanChan, 4, 3))
Trieu = Val(Mid$(PhanChan, 7, 3))
Ngan = Val(Mid$(PhanChan, 10, 3))
Dong = Val(Mid$(PhanChan, 13, 3))
If NganTy = 0 And Ty = 0 And Trieu = 0 And Ngan = 0 And Dong = 0 Then
BangChu = "không " + DonViTien + " "
i = 5
Else
BangChu = ""
i = 0
End If

'-----------------------------------------------------
While i <= 5
Select Case i
Case 0
SoDoi = NganTy
'Ten = "ngàn t" & ChrW(7927) ' ngàn ty
Ten = "ngàn"  ' ngàn ty
Case 1
SoDoi = Ty
Ten = "t" & ChrW(7927) ' ty
Case 2
SoDoi = Trieu
Ten = "tri" & ChrW(7879) & "u" ' trieu
Case 3
SoDoi = Ngan
Ten = "ngàn" ' ngàn
Case 4
SoDoi = Dong
Ten = DonViTien ' dong
Case 5
SoDoi = SoLe
Ten = DonViLe ' xu
End Select
If SoDoi <> 0 Then
    Tram = Int(SoDoi / 100)
    Muoi = Int((SoDoi - Tram * 100) / 10)
    DonVi = (SoDoi - Tram * 100) - Muoi * 10
    If Right(BangChu, 3) = " " Then
        BangChu = Left(BangChu, Len(BangChu) - 3)
    End If
    BangChu = BangChu + IIf(Len(BangChu) = 0, "", ", ") + _
    IIf(Tram <> 0, Trim(CharVND(Tram)) + " tr" & ChrW(259) & "m ", "")  '""
    If Muoi = 0 And Tram <> 0 And DonVi <> 0 Then
        BangChu = BangChu + "l" & ChrW(7867) & " "
    Else
        If Muoi <> 0 Then
            BangChu = BangChu + IIf(Muoi <> 0 And Muoi <> 1, _
            Trim(CharVND(Muoi)) + " m" & ChrW(432) & ChrW(417) & "i ", "m" & ChrW(432) & ChrW(7901) & "i ") 'muoi, mu+o+i`
        End If
    End If

    If Muoi <> 0 And DonVi = 5 Then
        BangChu = BangChu + "l" & ChrW(259) & "m " + Ten + " " 'la(m
    Else
        If Muoi > 1 And DonVi = 1 Then
            BangChu = BangChu + "m" & ChrW(7889) & "t " + Ten + " "  'Mo^/t
        Else
            BangChu = BangChu + IIf(DonVi <> 0, Trim(CharVND(DonVi)) + " " + Ten, Ten) + " "
        End If
    End If
Else
    BangChu = BangChu + IIf(i = 4, DonViTien + "", "")
End If
i = i + 1
Wend
If SoLe = 0 Then
BangChu = BangChu + IIf(Right(BangChu, 3) = " ", "", "") + "ch" & ChrW(7861) & "n" 'Cha(~n
End If
BangChu = Replace(BangChu, " ,", ",")
BangChu = UCase(Left(BangChu, 1)) + Right(BangChu, Len(BangChu) - 1)
vndFix = BangChu
End Function

'
Function DongVN(Num As Currency) As String
Dim arrSo, arrVT, arrChu, PhanChan
Dim NganTy As Integer, Ty As Integer, Trieu As Integer, Ngan As Integer, Dong As Integer, i As Integer
Dim Chu As String

Chu = vnd(Num)

PhanChan = Trim$(str$(Int(Num)))
PhanChan = Space(15 - Len(PhanChan)) + PhanChan

NganTy = Val(Left(PhanChan, 3))
Ty = Val(Mid$(PhanChan, 4, 3))
Trieu = Val(Mid$(PhanChan, 7, 3))
Ngan = Val(Mid$(PhanChan, 10, 3))
Dong = Val(Mid$(PhanChan, 13, 3))

arrSo = Array(NganTy, Ty, Trieu, Ngan, Dong)

ReDim arrVT(5)
ReDim arrChu(4)
For i = 0 To 4
    If arrSo(i) = 0 Then
        arrVT(i) = 0
    Else
        If i = 0 Then
            arrVT(i) = 0
        Else
            arrVT(i) = InStr(arrVT(i - 1) + 1, Chu, ",")
        End If
    End If
Next
arrVT(5) = Len(Chu) + 1

For i = 1 To 5
    If arrVT(i - 1) > 0 Then
        arrChu(i - 1) = Trim(Mid(Chu, arrVT(i - 1) + 1, arrVT(i) - arrVT(i - 1) - 1))
    Else
        If arrVT(i) = 0 Then
            arrChu(i - 1) = ""
        Else
            arrChu(i - 1) = Mid(Chu, arrVT(i - 1) + 1, arrVT(i) - arrVT(i - 1) - 1)
        End If
    End If
Next
Chu = ""
For i = 0 To 4
    If Len(arrVT(i)) > 0 And i = 0 Then
        Chu = Chu + Trim(Left(arrChu(i), Len(arrChu(i))))
    Else
        If Len(Trim(arrSo(i))) = 3 Then
            Chu = Chu + ", " + Trim(arrChu(i))
        ElseIf Len(Trim(arrSo(i))) = 2 Then
            Chu = Chu + "," + " không tr" & ChrW(259) & "m " + Trim(arrChu(i))
        ElseIf Len(Trim(arrSo(i))) = 1 Then
            Chu = Chu + "," + " không tr" & ChrW(259) + "m l" & ChrW(7867) & " " + Trim(arrChu(i))
        End If
    End If
Next
DongVN = Chu
End Function
Nhấp chuột vào đây để mở rộng...
Dạ, anh xem giúp em ạ. Khi em copy code vào chạy thì em không ra kết quả ạ (Em chạy thử ở sheet Data từ E2:E6 và sheet Biên bản ô B8. Em nghĩ bài này dùng vlookup sẽ ra ở phần này. Nhưng vì em đang học viết code, nên nếu có thể anh viết code giúp em ạ. Em cảm ơn anh. Em thấy khó khăn ở phần điền dữ liệu nhưng không nằm trong một ô (Đoạn: "Khách hàng ứng trước"). Có cách nào xử lý với đoạn này không ạ, vì đó là mẫu của công ty. Nếu không được, em sẽ tách riêng vào một ô ạ.
Bài đã được tự động gộp:

Hoàng Tuấn 868 đã viết:
1/ Phần cài đặt đọc số bằng chữ thì bạn có thể cài lại phiên bản khác, rất nhiều mà.
2/ Biên bản của bạn thiết kế không ổn, chắc bạn tự nghĩ ra, những đoạn bôi đỏ nên để riêng từng ô chứ gộp hết vào một ô thế này thì chỉ có giải pháp duy nhất là nhập tay. bạn nên điều chỉnh lại đã nhé.
Nhấp chuột vào đây để mở rộng...
Dạ, em có điều chỉnh lại file ở bài #4. Biên bản này là có thực tế, nhưng nội dung em đã bỏ bớt nên chỉ còn ví dụ thôi ạ.
 

File đính kèm

  • file.xlsb
    25 KB · Đọc: 4
Lần chỉnh sửa cuối:
Upvote 0
thao nguyen01 đã viết:
Dạ, anh xem giúp em ạ. Khi em copy code vào chạy thì em không ra kết quả ạ (Em chạy thử ở sheet Data từ E2:E6 và sheet Biên bản ô B8. Em nghĩ bài này dùng vlookup sẽ ra ở phần này. Nhưng vì em đang học viết code, nên nếu có thể anh viết code giúp em ạ. Em cảm ơn anh.
Nhấp chuột vào đây để mở rộng...
Bạn chép lại code bài #3 dùng tạm. Tôi sẽ tìm lại đoạn code đúng gửi sau
 
Upvote 0
Lần chỉnh sửa cuối:
Upvote 0
thao nguyen01 đã viết:
Dạ, em chép lại code bài #3 nhưng vẫn không ra kết quả ạ.
Nhấp chuột vào đây để mở rộng...
Bạn dùng thử code này - Nhưng lưu ý Ô số tiền không được thêm phần Text phía sau như thế - Chúc thành công

Function DocSo(ByVal Number, Optional ByVal Font = 1) As String
Dim MyArray
Dim Str
Str = Format(Abs(Number), "000000000000000000")
Select Case Font
Case 1
MyArray = Array("không ", "m" & ChrW(7897) & "t ", "hai ", "ba ", "b" & ChrW(7889) & "n ", "n" & ChrW(259) & "m ", "sáu ", "b" & ChrW(7843) & "y ", "tám ", "chín ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "t" & ChrW(7927) & ", ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "", "tr" & ChrW(259) & "m ", "m" & ChrW(432) & ChrW(417) & "i ", "không " & "m" & ChrW(432) & ChrW(417) & "i" & " không ", "không " & "m" & ChrW(432) & ChrW(417) & "i", "l" & ChrW(7867), "m" & ChrW(432) & ChrW(417) & "i" & " không", "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " n" & ChrW(259) & "m", "m" & ChrW(432) & ChrW(417) & "i" & " l" & ChrW(259) & "m", "m" & ChrW(7897) & "t " & "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(7901) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7897) & "t", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7889) & "t", "Âm ")
Case 2
MyArray = Array("khoâng ", "moät ", "hai ", "ba ", "boán ", "naêm ", "saùu ", "baûy ", "taùm ", "chín ", "trieäu, ", "ngaøn, ", "tyû, ", "trieäu, ", "ngaøn, ", "", "traêm ", "möôi ", "khoâng möôi khoâng ", "khoâng möôi", "leû", "möôi khoâng", "möôi", "möôi naêm", "möôi laêm", "moät möôi", "möôøi", "möôi moät", "möôi moát", "AÂm ")
Case 3
MyArray = Array("kh«ng ", "mét ", "hai ", "ba ", "bèn ", "n¨m ", "s¸u ", "b¶y ", "t¸m ", "chÝn ", "triÖu, ", "ngµn, ", "tû, ", "triÖu, ", "ngµn, ", "", "tr¨m ", "m¬i ", "kh«ng m¬i kh«ng ", "kh«ng m¬i", "lÎ", "m¬i kh«ng", "m¬i", "m¬i n¨m", "m¬i l¨m", "mét m¬i", "mêi", "m¬i mét", "m¬i mèt", "©m ")
End Select
If Str = "000000000000000000" Then
DocSo = UCase(Left(MyArray(0), 1)) & Trim(Mid(MyArray(0), 2)) & " " '& "."
Exit Function
End If
For i = 1 To Len(Str)
If Left(Str, i) <> 0 And Mid(Str, (Int((i + 2) / 3) - 1) * 3 + 1, 3) <> 0 Then
DocSo = DocSo & MyArray(Mid(Str, i, 1)) & MyArray(-(9 + i / 3) * (i Mod 3 = 0) - (15 + i Mod 3) * (i Mod 3 <> 0))
ElseIf i = 9 And Mid(Str, 7, 3) = 0 And Left(Str, 6) <> 0 Then
DocSo = DocSo & MyArray(12)
End If
Next
DocSo = Trim(Replace(Replace(Replace(Replace(Replace(Replace(DocSo, MyArray(18), MyArray(15)), MyArray(19), MyArray(20)), MyArray(21), MyArray(22)), MyArray(23), MyArray(24)), MyArray(25), MyArray(26)), MyArray(27), MyArray(28)))
If Number < 0 Then
DocSo = MyArray(29) & DocSo
End If
DocSo = Replace(UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & " ", ",.", " ")
End Function
 
Upvote 0
Maika8008 đã viết:
Tôi thấy bạn để giá trị là 20.000.000 đồng thì nó không đọc được. Bỏ chữ đồng đi chứ!

P/S: Tôi đã sửa lại code đúng cho bài 3. Bạn thử, có gì báo lại.
Nhấp chuột vào đây để mở rộng...
Dạ, em copy code lại nhưng vẫn không ra kết quả ạ. Anh xem file giúp em. Em chạy code của anh ở ô C7 ạ. Anh xem giúp em với ạ.
Bài đã được tự động gộp:

le_vis đã viết:
Bạn dùng thử code này - Nhưng lưu ý Ô số tiền không được thêm phần Text phía sau như thế - Chúc thành công

Function DocSo(ByVal Number, Optional ByVal Font = 1) As String
Dim MyArray
Dim Str
Str = Format(Abs(Number), "000000000000000000")
Select Case Font
Case 1
MyArray = Array("không ", "m" & ChrW(7897) & "t ", "hai ", "ba ", "b" & ChrW(7889) & "n ", "n" & ChrW(259) & "m ", "sáu ", "b" & ChrW(7843) & "y ", "tám ", "chín ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "t" & ChrW(7927) & ", ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "", "tr" & ChrW(259) & "m ", "m" & ChrW(432) & ChrW(417) & "i ", "không " & "m" & ChrW(432) & ChrW(417) & "i" & " không ", "không " & "m" & ChrW(432) & ChrW(417) & "i", "l" & ChrW(7867), "m" & ChrW(432) & ChrW(417) & "i" & " không", "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " n" & ChrW(259) & "m", "m" & ChrW(432) & ChrW(417) & "i" & " l" & ChrW(259) & "m", "m" & ChrW(7897) & "t " & "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(7901) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7897) & "t", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7889) & "t", "Âm ")
Case 2
MyArray = Array("khoâng ", "moät ", "hai ", "ba ", "boán ", "naêm ", "saùu ", "baûy ", "taùm ", "chín ", "trieäu, ", "ngaøn, ", "tyû, ", "trieäu, ", "ngaøn, ", "", "traêm ", "möôi ", "khoâng möôi khoâng ", "khoâng möôi", "leû", "möôi khoâng", "möôi", "möôi naêm", "möôi laêm", "moät möôi", "möôøi", "möôi moät", "möôi moát", "AÂm ")
Case 3
MyArray = Array("kh«ng ", "mét ", "hai ", "ba ", "bèn ", "n¨m ", "s¸u ", "b¶y ", "t¸m ", "chÝn ", "triÖu, ", "ngµn, ", "tû, ", "triÖu, ", "ngµn, ", "", "tr¨m ", "m¬i ", "kh«ng m¬i kh«ng ", "kh«ng m¬i", "lÎ", "m¬i kh«ng", "m¬i", "m¬i n¨m", "m¬i l¨m", "mét m¬i", "mêi", "m¬i mét", "m¬i mèt", "©m ")
End Select
If Str = "000000000000000000" Then
DocSo = UCase(Left(MyArray(0), 1)) & Trim(Mid(MyArray(0), 2)) & " " '& "."
Exit Function
End If
For i = 1 To Len(Str)
If Left(Str, i) <> 0 And Mid(Str, (Int((i + 2) / 3) - 1) * 3 + 1, 3) <> 0 Then
DocSo = DocSo & MyArray(Mid(Str, i, 1)) & MyArray(-(9 + i / 3) * (i Mod 3 = 0) - (15 + i Mod 3) * (i Mod 3 <> 0))
ElseIf i = 9 And Mid(Str, 7, 3) = 0 And Left(Str, 6) <> 0 Then
DocSo = DocSo & MyArray(12)
End If
Next
DocSo = Trim(Replace(Replace(Replace(Replace(Replace(Replace(DocSo, MyArray(18), MyArray(15)), MyArray(19), MyArray(20)), MyArray(21), MyArray(22)), MyArray(23), MyArray(24)), MyArray(25), MyArray(26)), MyArray(27), MyArray(28)))
If Number < 0 Then
DocSo = MyArray(29) & DocSo
End If
DocSo = Replace(UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & " ", ",.", " ")
End Function
Nhấp chuột vào đây để mở rộng...
Dạ, em chạy thử code của anh ra ạ. Nhưng sau khi đọc 20.000.000, kết quả là "Hai mươi triệu," có thêm dấu phẩy ạ.
 

File đính kèm

  • file.xlsb
    32.7 KB · Đọc: 4
Upvote 0
le_vis đã viết:
Bạn dùng thử code này - Nhưng lưu ý Ô số tiền không được thêm phần Text phía sau như thế - Chúc thành công

Function DocSo(ByVal Number, Optional ByVal Font = 1) As String
Dim MyArray
Dim Str
Str = Format(Abs(Number), "000000000000000000")
Select Case Font
Case 1
MyArray = Array("không ", "m" & ChrW(7897) & "t ", "hai ", "ba ", "b" & ChrW(7889) & "n ", "n" & ChrW(259) & "m ", "sáu ", "b" & ChrW(7843) & "y ", "tám ", "chín ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "t" & ChrW(7927) & ", ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "", "tr" & ChrW(259) & "m ", "m" & ChrW(432) & ChrW(417) & "i ", "không " & "m" & ChrW(432) & ChrW(417) & "i" & " không ", "không " & "m" & ChrW(432) & ChrW(417) & "i", "l" & ChrW(7867), "m" & ChrW(432) & ChrW(417) & "i" & " không", "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " n" & ChrW(259) & "m", "m" & ChrW(432) & ChrW(417) & "i" & " l" & ChrW(259) & "m", "m" & ChrW(7897) & "t " & "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(7901) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7897) & "t", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7889) & "t", "Âm ")
Case 2
MyArray = Array("khoâng ", "moät ", "hai ", "ba ", "boán ", "naêm ", "saùu ", "baûy ", "taùm ", "chín ", "trieäu, ", "ngaøn, ", "tyû, ", "trieäu, ", "ngaøn, ", "", "traêm ", "möôi ", "khoâng möôi khoâng ", "khoâng möôi", "leû", "möôi khoâng", "möôi", "möôi naêm", "möôi laêm", "moät möôi", "möôøi", "möôi moät", "möôi moát", "AÂm ")
Case 3
MyArray = Array("kh«ng ", "mét ", "hai ", "ba ", "bèn ", "n¨m ", "s¸u ", "b¶y ", "t¸m ", "chÝn ", "triÖu, ", "ngµn, ", "tû, ", "triÖu, ", "ngµn, ", "", "tr¨m ", "m¬i ", "kh«ng m¬i kh«ng ", "kh«ng m¬i", "lÎ", "m¬i kh«ng", "m¬i", "m¬i n¨m", "m¬i l¨m", "mét m¬i", "mêi", "m¬i mét", "m¬i mèt", "©m ")
End Select
If Str = "000000000000000000" Then
DocSo = UCase(Left(MyArray(0), 1)) & Trim(Mid(MyArray(0), 2)) & " " '& "."
Exit Function
End If
For i = 1 To Len(Str)
If Left(Str, i) <> 0 And Mid(Str, (Int((i + 2) / 3) - 1) * 3 + 1, 3) <> 0 Then
DocSo = DocSo & MyArray(Mid(Str, i, 1)) & MyArray(-(9 + i / 3) * (i Mod 3 = 0) - (15 + i Mod 3) * (i Mod 3 <> 0))
ElseIf i = 9 And Mid(Str, 7, 3) = 0 And Left(Str, 6) <> 0 Then
DocSo = DocSo & MyArray(12)
End If
Next
DocSo = Trim(Replace(Replace(Replace(Replace(Replace(Replace(DocSo, MyArray(18), MyArray(15)), MyArray(19), MyArray(20)), MyArray(21), MyArray(22)), MyArray(23), MyArray(24)), MyArray(25), MyArray(26)), MyArray(27), MyArray(28)))
If Number < 0 Then
DocSo = MyArray(29) & DocSo
End If
DocSo = Replace(UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & " ", ",.", " ")
End Function
Nhấp chuột vào đây để mở rộng...
Code ổn nhưng các số như 415.215.000 nó lại dư dấu phẩy và 1 khoảng trắng đàng sau (Bốn trăm mười lăm triệu, hai trăm mười lăm ngàn, ) và không có chữ "đồng" ở cuối. Chữ đồng đó thì dễ dàng thêm vào được (không liên quan đến giải thuật) nhưng cái dấu dấu phẩy và 1 khoảng trắng đó là do nhầm giải thuật.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

pupuchcha
  • Question
Viết code để tìm xích ma, mong mọi người giúp đỡ em ạ
Trả lời
1
Đọc
47
VetMini
V
Bich2B
lỗi định dạng ngày không đọc được công thức excel
Trả lời
9
Đọc
217
thaiduylamus
thaiduylamus
C
Giúp em viết công thức làm lịch thi đấu.
Trả lời
0
Đọc
25
caocat
C
D
Tính khoảng cách giữa 2 tọa độ?
Trả lời
4
Đọc
77
danhculao
D
K
Nhờ mọi người hỗ trợ giúp mình về tìm kiếm trong VBA. Mình sẽ gửi chút chi phí cafe cám ơn nhiều ạ
    • Cười
Trả lời
18
Đọc
321
VetMini
V
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom