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
241
Được thích
30
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

ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
11 12 13
Trả lời
246
Đọc
13K
trannguyen197
T
Tuấn Bụng Bự
  • Question
Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)
2
Trả lời
28
Đọc
603
Tuấn Bụng Bự
Tuấn Bụng Bự
C
Chia sẻ: Kết quả xổ số Keno
    • Cười
    • Thích
Trả lời
9
Đọc
236
ptm0412
ptm0412
P
Tổng hợp dữ liệu từ các sheet theo chọn lọc
Trả lời
14
Đọc
269
ptm0412
ptm0412
B
Định dạng condition formatting, đếm hỗn hợp dữ liệu merge và không merge
Trả lời
7
Đọc
117
Hoàng Tuấn 868
H
T
Tối ưu hóa hàm lấy dữ liệu từ bảng Tổng sang bảng chi tiết
Trả lời
7
Đọc
213
Hoàng Tuấn 868
H
nguyenphuochien166
Cách Vlookup hoặc cách lấy thông tin dữ liệu có dấu mũ lũy thừa?
    • Cười
Trả lời
6
Đọc
108
tigertiger
tigertiger
T
Không đếm dữ liệu rỗng trong PivotTable
Trả lời
8
Đọc
1K
hoangtuaotrang_hp_vn
H
B
Lọc dữ liệu trùng, đếm số lần, tự tô màu theo điều kiện.
Trả lời
3
Đọc
114
batista911
B
C
Công thức tự nhập liệu số lượng nhập khi bị âm
Trả lời
1
Đọc
92
hoangtuaotrang_hp_vn
H
kimtanmap
  • Question
Nhờ viết code VBA Macro lập lại.
Trả lời
5
Đọc
155
kimtanmap
kimtanmap
dung09031989
Xin giúp công thức tô màu các ô phía sau khi kế hoạch đặt hàng thiếu so với tồn kho.?
Trả lời
1
Đọc
77
hoangtuaotrang_hp_vn
H
huynhnhu1234
Tìm giá vé máy bay một chiều và khứ hồi
Trả lời
0
Đọc
49
huynhnhu1234
huynhnhu1234
V
[Nhờ giúp đỡ] Cách tìm thời gian bị trùng trong excel ở nhiều thời gian khác nhau
Trả lời
7
Đọc
127
tranvansau278
T
N
Hàm tìm giá trị theo giờ vào - ra
Trả lời
6
Đọc
120
Nguyễn Linh hn94
N
zarra
Cần giúp tạo form in mã vạch cho vật tư theo SL cụ thể.
Trả lời
4
Đọc
164
zarra
zarra
Nguyễn Duy Tuân
  • Question
Chia sẻ ControlForOffice - Bộ công cụ điều khiển Office/Excel
    • Thích
6 7 8
Trả lời
148
Đọc
95K
leminhksvl
L
HeSanbi
  • Question
Lỗi VBA: Cài đặt thông số ForceVBALoadFromSource trong Registry để VBA biên dịch không bị lỗi
    • Cảm ơn
    • Thích
Trả lời
5
Đọc
296
anhdepjai
A
H
Hàm đếm số ngày thứ bảy và chủ nhật trong một khoảng thời gian
Trả lời
17
Đọc
20K
DeTong
D
D
  • Question
Xin cách sắp xếp dữ liệu theo thứ tự không làm hỏng link
Trả lời
7
Đọc
306
cantl
C
Xem thêm…

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