Chuyên đề giải đáp những thắc mắc về code VBA

Liên hệ QC
maytinhvp01

maytinhvp01

Thành viên thường trực
Tham gia
27/7/13
Bài viết
390
Được thích
179
Mình muốn nhờ giải thich câu lệnh " If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c) "
trong ví du:
Public Function LonNhat(Ran As Range)
Dim max As Double, v As Integer, d As Integer, c As Integer
max = Ran.Cells(1, 1)
For d = 1 To Ran.Rows.Count
For c = 1 To Ran.Columns.Count
If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c)
Next c
Next d
v = Tim(max, Ran)
LonNhat = max
End Function
-------------------------------------------------------
[INFO1]Thông báo:
Vì topic này:
http://www.giaiphapexcel.com/forum/...ải-thích-các-code-đề-nghị-các-bạn-gửi-vào-đây
đã quá dài nên BQT đóng lại.
Nay tôi mở topic mới với cùng chủ đề: GIẢI THÍCH NHỮNG THẮC MẮC VỀ CODE
Các bạn nếu có nhu cầu giải thích code, vui lòng post tại đây nhé
NDU96081631
[/INFO1]
 
Chỉnh sửa lần cuối bởi điều hành viên:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Maika8008 đã viết:
Dòng nào không hiểu? "có dòng lệnh này em vẫn chưa hiểu" trong khi đưa cả tập lệnh mà không chỉ dòng nào là sao?
Nhấp chuột vào đây để mở rộng...
dạ chào anh. em chưa hiểu tập lệnh này anh ạ. Em có file đính kèm ở sheet account em muốn thêm mấy account nữa vào. mà em create button "insert bottom row" mà không hoạt động. Mong anh chỉ giáo giúp em.
Set ARange = Range(AccountFrame) câu lệnh này báo lỗi anh ạ.
 

File đính kèm

Upvote 0
tototolon_123 đã viết:
dạ chào anh. em chưa hiểu tập lệnh này anh ạ. Em có file đính kèm ở sheet account em muốn thêm mấy account nữa vào. mà em create button "insert bottom row" mà không hoạt động. Mong anh chỉ giáo giúp em.
Set ARange = Range(AccountFrame) câu lệnh này báo lỗi anh ạ.
Nhấp chuột vào đây để mở rộng...
Bạn dò xem biến AccountFrame nạp dữ liệu địa chỉ vùng bảng tính từ đâu, lúc nào? Biến này rỗng hoặc sai là lệnh set range bị lỗi.
 
Upvote 0
Nhờ Thầy cô anh, chị hướng dẫn code ShowFilterFile như sau
Khi sheet Data có Filter thì xả filter (các sheet khác không xả)
Mã: 
Sub ShowFilterFile()
        If Sheets("Data").AutoFilterMode Then
            ActiveSheet.ShowAllData
        End If
End Sub
code trên chỉ đúng khi sheet Data có filter, còn không có thì nó báo lỗi ở dòng
Mã: 
  ActiveSheet.ShowAllData
Làm sao khi sheet Data không có filter thì nó bỏ qua
Lưu ý: không bỏ các mũi tên filter
Em cảm ơn!
 
Upvote 0
AnhThu-1976 đã viết:
Nhờ Thầy cô anh, chị hướng dẫn code ShowFilterFile như sau
Khi sheet Data có Filter thì xả filter (các sheet khác không xả)
Mã: 
Sub ShowFilterFile()
        If Sheets("Data").AutoFilterMode Then
            ActiveSheet.ShowAllData
        End If
End Sub
code trên chỉ đúng khi sheet Data có filter, còn không có thì nó báo lỗi ở dòng
Mã: 
  ActiveSheet.ShowAllData
Làm sao khi sheet Data không có filter thì nó bỏ qua
Lưu ý: không bỏ các mũi tên filter
Em cảm ơn!
Nhấp chuột vào đây để mở rộng...
Thêm lệnh On errror resume Next là đc mà.
 
Upvote 0
PHP: 
'.......................
Dim Dict
Dim k1 As String, k2 As String, k3 As String
For i = 1 to j
'......................
Dict.Add k1, i
'......................
Dict.Add k2, i
'......................
Dict.Add k3, i
'......................
'Gan toan bo Dict.Item có trong Dict xuong Sheets1.Range("F1")
Next i

Với mỗi 1 cú pháp "If - End If" và 1 đơn vị của " i " thì em Add vào Dictionary(VBA) được một Key.
Giá trị i chạy đến j thì em được tập hợp các Key đã Add vào Dict lần lượt là k1, k2, k3
Cuối cùng: Muốn dán toàn bộ Key có trong Dictionary (VBA) xuống Sheet1 tại ô F1 thì cú pháp làm sao ạ. Xin chỉ giúp em với ạ!
 
Upvote 0
Mã: 
Option Explicit

Public Sub Gpe()
Dim sArr(), dArr(), I As Long, Txt As String, R As Long
    sArr = Range("C3", Range("D50000").End(xlUp)).Resize(, 2).Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 1)
For I = 1 To R
    If Len(sArr(I, 2)) > 10 Then Txt = sArr(I, 2)
    dArr(I, 1) = Txt
Next I
Range("A3").Resize(R) = dArr
End Sub

Sub TimKiem()
Dim Rng As Range, R As Long, Txt As String
    R = Range("A50000").End(xlUp).Row
Set Rng = Range("A2:A" & R)
    Txt = Range("A1").Value
    If Len(Txt) Then
        Rng.AutoFilter Field:=1, Criteria1:=Txt
    Else
        Rng.AutoFilter
    End If
End Sub
với Code hiện tại thì khi cần tìm kiếm phải chỉ đích danh chuỗi : Số đơn hàng/mã hàng/màu sắc / số lượng / quốc gia : (226142/S8113TW/A05=312 Mỹ)
Em nên topic mong nhận được sự chỉ dẫn 1 đoạn Code Chỉ cần tìm kiếm dạng chuỗi : Số đơn hàng/mã hàng/màu sắc ( 226142/S8113TW/A05 ) và ở dạng tìm kiếm rộng hơn là Số đơn hàng/mã hàng ( 226142/S8113TW )- là đã có thể lọc ra kết quả cần tìm kiếm
Em xin cảm ơn ạ !1615019754951.png
 

File đính kèm

Upvote 0
Code này chạy mất 6s:
Mã: 
Sub TinhLaiNhapXuatTon_NEW()
Dim lrMaHang As Long
With Sheets("MAHANG")
    lrMaHang = .Range("E" & Rows.Count).End(xlUp).Row
    If lrMaHang < 9 Then Exit Sub
    .Range("U9:Z10008").ClearContents
    .Range("U9:U" & lrMaHang).Formula = "=SUMIFS(SOLUONG_NK,TENHANG_NK,rc[-16]) - SUMIFS(SOLUONG_XE,TENHANG_XE,rc[-16],GHICHU_XE,""Nhap Lai Kho"")-(SUMIFS(SOLUONG_XK,TENHANG_XK,rc[-16],XEBAN_XK,"""")+SUMIFS(SOLUONG_XE,TENHANG_XE,rc[-16],GHICHU_XE,""Kho Len Xe""))"
    .Range("W9:W" & lrMaHang).Formula = "=SUMIFS(SOLUONG_NK,TENHANG_NK,rc[-18],NGAY_NK,""<""&TUNGAY_MH) - SUMIFS(SOLUONG_XE,TENHANG_XE,rc[-18],NGAY_XE,""<""&TUNGAY_MH,GHICHU_XE,""Nhap Lai Kho"")-(SUMIFS(SOLUONG_XK,TENHANG_XK,rc[-18],NGAY_BH,""<""&TUNGAY_MH,XEBAN_XK,"""")+SUMIFS(SOLUONG_XE,TENHANG_XE,rc[-18],NGAY_XE,""<""&TUNGAY_MH,GHICHU_XE,""Kho Len Xe""))"
    .Range("X9:X" & lrMaHang).Formula = "=SUMIFS(SOLUONG_NK,TENHANG_NK,rc[-19],NGAY_NK,"">=""&TUNGAY_MH,NGAY_NK,""<=""&DENNGAY_MH) - SUMIFS(SOLUONG_XE,TENHANG_XE,rc[-19],NGAY_XE,"">=""&TUNGAY_MH,NGAY_XE,""<=""&DENNGAY_MH,GHICHU_XE,""Nhap Lai Kho"")"
    .Range("Y9:Y" & lrMaHang).Formula = "=SUMIFS(SOLUONG_XK,TENHANG_XK,rc[-20],NGAY_BH,"">=""&TUNGAY_MH,NGAY_BH,""<=""&DENNGAY_MH,XEBAN_XK,"""")+SUMIFS(SOLUONG_XE,TENHANG_XE,rc[-20],NGAY_XE,"">=""&TUNGAY_MH,NGAY_XE,""<=""&DENNGAY_MH,GHICHU_XE,""Kho Len Xe"")"
    .Range("Z9:Z" & lrMaHang).Formula = "=RC[-3] + RC[-2] - RC[-1]"
    .Range("U9:Z" & lrMaHang).Value = .Range("U9:Z" & lrMaHang).Value
End With

End Sub

Nhưng sau khi thêm dòng này vào: Application.Calculation = xlCalculationManual thì thì chỉ mất 0.007 giây, vẫn ra kết quả.
Mã: 
Sub TinhLaiNhapXuatTon_NEW()

Application.Calculation = xlCalculationManual
'Dim t As Single
't = Timer
''code

Dim lrMaHang As Long
With Sheets("MAHANG")
    lrMaHang = .Range("E" & Rows.Count).End(xlUp).Row
    If lrMaHang < 9 Then Exit Sub
    .Range("U9:Z10008").ClearContents
    .Range("U9:U" & lrMaHang).Formula = "=SUMIFS(SOLUONG_NK,TENHANG_NK,rc[-16]) - SUMIFS(SOLUONG_XE,TENHANG_XE,rc[-16],GHICHU_XE,""Nhap Lai Kho"")-(SUMIFS(SOLUONG_XK,TENHANG_XK,rc[-16],XEBAN_XK,"""")+SUMIFS(SOLUONG_XE,TENHANG_XE,rc[-16],GHICHU_XE,""Kho Len Xe""))"
    .Range("W9:W" & lrMaHang).Formula = "=SUMIFS(SOLUONG_NK,TENHANG_NK,rc[-18],NGAY_NK,""<""&TUNGAY_MH) - SUMIFS(SOLUONG_XE,TENHANG_XE,rc[-18],NGAY_XE,""<""&TUNGAY_MH,GHICHU_XE,""Nhap Lai Kho"")-(SUMIFS(SOLUONG_XK,TENHANG_XK,rc[-18],NGAY_BH,""<""&TUNGAY_MH,XEBAN_XK,"""")+SUMIFS(SOLUONG_XE,TENHANG_XE,rc[-18],NGAY_XE,""<""&TUNGAY_MH,GHICHU_XE,""Kho Len Xe""))"
    .Range("X9:X" & lrMaHang).Formula = "=SUMIFS(SOLUONG_NK,TENHANG_NK,rc[-19],NGAY_NK,"">=""&TUNGAY_MH,NGAY_NK,""<=""&DENNGAY_MH) - SUMIFS(SOLUONG_XE,TENHANG_XE,rc[-19],NGAY_XE,"">=""&TUNGAY_MH,NGAY_XE,""<=""&DENNGAY_MH,GHICHU_XE,""Nhap Lai Kho"")"
    .Range("Y9:Y" & lrMaHang).Formula = "=SUMIFS(SOLUONG_XK,TENHANG_XK,rc[-20],NGAY_BH,"">=""&TUNGAY_MH,NGAY_BH,""<=""&DENNGAY_MH,XEBAN_XK,"""")+SUMIFS(SOLUONG_XE,TENHANG_XE,rc[-20],NGAY_XE,"">=""&TUNGAY_MH,NGAY_XE,""<=""&DENNGAY_MH,GHICHU_XE,""Kho Len Xe"")"
    .Range("Z9:Z" & lrMaHang).Formula = "=RC[-3] + RC[-2] - RC[-1]"
    .Range("U9:Z" & lrMaHang).Value = .Range("U9:Z" & lrMaHang).Value
End With
'MsgBox Timer - t
Application.Calculation = xlCalculationAutomatic

End Sub

Cho em hỏi tại sao có sự khác biệt như vậy ạ? em cứ nghĩ thêm Application.Calculation = xlCalculationManual thì excel sẽ ngưng tính toán, và công thức kia gán xuống sheets cũng ko chạy được chứ nhỉ?
Mong cả nhà giải đáp giúp em để em thông suốt ạ!
 
Upvote 0
Em có cái lệnh VBA tách 100 dòng ra 1 file nhưng khi tách nó ko dư lại tiêu đề của nội dung. Em muốn nhờ các bác sửa hộ em lệnh cho nó dữ lại tiêu đề ở các file tác ra ạ. code VBA em đính kèm ạ. Em cảm ơn các bác nhiều
 

File đính kèm

Upvote 0
kiendaide1 đã viết:
Em có cái lệnh VBA tách 100 dòng ra 1 file nhưng khi tách nó ko dư lại tiêu đề của nội dung. Em muốn nhờ các bác sửa hộ em lệnh cho nó dữ lại tiêu đề ở các file tác ra ạ. code VBA em đính kèm ạ. Em cảm ơn các bác nhiều
Nhấp chuột vào đây để mở rộng...
Mình quăng chài vừa thôi chứ.

Quăng nhiều thế là hư lưới đó.


1615198101863.png
 
Upvote 0
Em lượm nhặt được code của anh huuthang_bd về đổi số thành chữ, nhưng không biết cách ghép thêm chữ "đồng" vào cuối đoạn code này, anh chị nào có thể giúp em để em tạo add in được ok ạ
Mã: 
'huuthang_bd - giaiphapexcel.com
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
Em cám ơn ạ !
 
Upvote 0
iamnobika đã viết:
Em lượm nhặt được code của anh huuthang_bd về đổi số thành chữ, nhưng không biết cách ghép thêm chữ "đồng" vào cuối đoạn code này, anh chị nào có thể giúp em để em tạo add in được ok ạ
Mã: 
'huuthang_bd - giaiphapexcel.com
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
Em cám ơn ạ !
Nhấp chuột vào đây để mở rộng...
Bạn thử đoạn dưới nhé:
Rich (BB code): 
'huuthang_bd - giaiphapexcel.com
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) & ".", ",.", ".")
DocSo = DocSo(UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & ".", ",.", " ") & ChrW$(273) & ChrW$(7891) & "ng."
DocSo = Replace(DocSo, "." & ChrW$(273) & ChrW$(7891) & "ng.", " " & ChrW$(273) & ChrW$(7891) & "ng.")
End Function
 
Upvote 0
iamnobika đã viết:
Bị lỗi rồi a ạ, bảo sao lúc thêm add in nó ko gọi hàm ra đc
View attachment 255251
Nhấp chuột vào đây để mở rộng...

Bạn thử lại nhé:
Rich (BB code): 
'huuthang_bd - giaiphapexcel.com
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) & ".", ",.", ".")
DocSo = Replace(UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & ".", ",.", " ") & ChrW$(273) & ChrW$(7891) & "ng."
DocSo = Replace(DocSo, "." & ChrW$(273) & ChrW$(7891) & "ng.", " " & ChrW$(273) & ChrW$(7891) & "ng.")
End Function
 
Upvote 0
1615708312890.png
Làm cách nào để em có thể khai báo biến i để có thể chọn được 1 dòng, hai dòng nhiều dòng theo ý mình chọn để coppy sang sheet khác ạ. Em mới biết VBA nên không rõ cách làm. Mong được giúp đỡ. Em cảm ơn nhiều!!!!
 
Upvote 0
Hân Đỗ đã viết:
View attachment 255395
Làm cách nào để em có thể khai báo biến i để có thể chọn được 1 dòng, hai dòng nhiều dòng theo ý mình chọn để coppy sang sheet khác ạ. Em mới biết VBA nên không rõ cách làm. Mong được giúp đỡ. Em cảm ơn nhiều!!!!
Nhấp chuột vào đây để mở rộng...
Bạn nêu rõ điều kiện và ví dụ kết quả mong muốn vào file gửi lên xem thế nào nhé.
 
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

M
  • Question Question
Code VBA tìm mã kiện gỗ còn tồn kho
Trả lời
2
Đọc
69
HieuCD
H
S
Tính trung bình của tháng đầu tiên.
Trả lời
4
Đọc
231
SteveNguyen1991
S
X
Tự động giãn dòng và ẩn các dòng bị bỏ trống
Trả lời
2
Đọc
90
xuanthucle
X
A
  • Đã giải quyết
Xin giúp đỡ code VBA chép cột dữ liệu có điều kiện từ file này sang file khác
2 3
Trả lời
59
Đọc
3K
Hoàng Nhật Phương
Hoàng Nhật Phương
T
  • Question Question
Xin code VBA trả về tên tài khoản theo điều kiện
    • Chấp nhận
Trả lời
10
Đọc
216
DeTong
D
H
Nhờ các cao nhân chỉ giáo code file Form nhập liệu Google Sheet !!!
    • Thích
Trả lời
4
Đọc
91
befaint
befaint
hoamattroicoi
TỔNG HỢP TỜ KHAI THUẾ THEO THÔNG TƯ 80/2021 TỪ *.XML SANG EXCEL
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
7
Đọc
3K
Nguyễn Văn Thái 92
N
N
  • Question Question
Cần giúp rút gọn code vba
Trả lời
7
Đọc
184
DeTong
D
dungdodac
Lỗi khi COPY , viền xung quanh ô được chọn đứng yên, không chạy
    • Cười
Trả lời
4
Đọc
203
VetMini
V
B
Xin hàm đếm số lượng khách hàng theo 1 điều kiện và bỏ dữ liệu trùng.
Trả lời
10
Đọc
373
Phan Thế Hiệp
Phan Thế Hiệp
Manhhung90
  • Question Question
Xin giúp chuyển dữ liệu từ cột dọc sang hàng ngang theo điều kiện
    • Cười
Trả lời
1
Đọc
51
Hoàng Tuấn 868
H
HeSanbi
  • Đã giải quyết
ExplorerXL - Quản lý thư mục với Excel: tìm, đổi tên, sao chép, di chuyển và xóa
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
79
Đọc
16K
viethung78
V
H
Giao diện mới ở "chế độ tối" mờ quá
    • Yêu thích
    • Thích
Trả lời
4
Đọc
141
OverAC
OverAC
J
quản lý dữ liệu theo cách quản lý bãi container
    • Thích
Trả lời
2
Đọc
7K
vunhai
V
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
13 14 15
Trả lời
298
Đọc
20K
ongke0711
ongke0711
M
Sắp xếp dữ liệu: Lọc tên theo ABC (alphabet) có lỗi tên Đam đứng trước Diệp
Trả lời
13
Đọc
5K
maidinhdung5
maidinhdung5
Nguyễn Duy Tuân
Hàm BS_FORMATTEXT Tạo công thức định dạng văn bản trong Excel với Add-in A-Tools v10
Trả lời
0
Đọc
43
Nguyễn Duy Tuân
Nguyễn Duy Tuân
Nguyễn Duy Tuân
Hàm BS_TEXT trộn văn bản trong Excel với Add-in A-Tools v10
Trả lời
0
Đọc
36
Nguyễn Duy Tuân
Nguyễn Duy Tuân
aduc
Nhật ký thi công bằng excel
    • Thích
2
Trả lời
36
Đọc
53K
PhanTuHuong
PhanTuHuong
likosin
xin cách lọc này với ạ.
Trả lời
4
Đọc
141
ptm0412
ptm0412
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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới
Back
Top Bottom