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
NHN_Phương đã viết:
Ơ, con mang code vào phòng thí nghiệm để tét với chiêu thiên nga múa các kiểu, kết quả tuyệt vời không kém gì phương pháp của Bạn @befaint chú Mỹ ơi .
Không có cảm giác chậm lắm chú Mỹ,thay vì phải xử lý từng dòng trên bảng tính thì kết hợp với Union gàn hết vào một thể xong rồi xử lý một lần được không chú Mỹ nhỉ?
Nhấp chuột vào đây để mở rộng...
Không union được, Còn phương pháp thì giống y của bi phèn nhá! Chỉ khác công cụ và thủ thuật thôi nhá!
Trường hợp chậm là khi dữ liệu rất nhiều nhưng chỉ insert 1 số ít năm ba dòng
 
Upvote 0
ptm0412 đã viết:
Không union được
Nhấp chuột vào đây để mở rộng...
Dạ vâng, vậy thôi chú Mỹ con chỉ mong chờ thêm xem nếu sử dụng được Union thì sẽ thế nào thôi ạ. Còn với cách nào nữa thì thôi ạ.. cách của chú Mỹ và của Bạn @befaint quá ổn rồi ạ.
Dạ thôi con xin phép đây, chú Mỹ tiếp tục múa đi nha :D, con ngủ đây ạ,chúc chú Mỹ ngủ ngon.
 
Upvote 0
NHN_Phương đã viết:
Dạ vâng, vậy thôi chú Mỹ con chỉ mong chờ thêm xem nếu sử dụng được Union thì sẽ thế nào thôi ạ. Còn với cách nào nữa thì thôi ạ.. cách của chú Mỹ và của Bạn @befaint quá ổn rồi ạ.
Dạ thôi con xin phép đây, chú Mỹ tiếp tục múa đi nha :D, con ngủ đây ạ,chúc chú Mỹ ngủ ngon.
Nhấp chuột vào đây để mở rộng...
Dùng mảng lưu thứ tự dòng, tự thêm lệnh tăng tốc code ( application. )
Mã: 
Sub ThemDong_ABC()
    
  Range("B3:D4,C6:J7,A9:E12").Select 'Test
  If TypeName(Selection) <> "Range" Then Exit Sub
 
  Dim fRow&, eRow&, i&
  Dim iRow As Range, Rng As Range, aRow() As Boolean
    
  Set Rng = Selection
  fRow = Rows.Count: eRow = 10 'Tuy hi?: 10>0
  ReDim aRow(1 To eRow)
  For Each iRow In Rng.Rows
    i = iRow.Row
    If i > eRow Then
      eRow = i
      If eRow > UBound(aRow) Then ReDim Preserve aRow(1 To eRow + 100) 'Tuy hi?: 100>=0
    End If
    If i < fRow Then fRow = i
    aRow(i) = True
  Next iRow
  For i = eRow To fRow Step -1
    If aRow(i) Then
      Rows(i & ":" & i).Insert Shift:=xlUp
      Rows(i + 1 & ":" & i + 1).Copy Rows(i & ":" & i)
    End If
  Next i
  Range("A" & i + 1).Select
  Erase aRow: Set Rng = Nothing: Set RngEx = Nothing: Set iRow = Nothing
End Sub
 
Upvote 0
HieuCD đã viết:
Dùng mảng lưu thứ tự dòng, tự thêm lệnh tăng tốc code ( application. )
Mã: 
Sub ThemDong_ABC()
   
  Range("B3:D4,C6:J7,A9:E12").Select 'Test
  If TypeName(Selection) <> "Range" Then Exit Sub

  Dim fRow&, eRow&, i&
  Dim iRow As Range, Rng As Range, aRow() As Boolean
   
  Set Rng = Selection
  fRow = Rows.Count: eRow = 10 'Tuy hi?: 10>0
  ReDim aRow(1 To eRow)
  For Each iRow In Rng.Rows
    i = iRow.Row
    If i > eRow Then
      eRow = i
      If eRow > UBound(aRow) Then ReDim Preserve aRow(1 To eRow + 100) 'Tuy hi?: 100>=0
    End If
    If i < fRow Then fRow = i
    aRow(i) = True
  Next iRow
  For i = eRow To fRow Step -1
    If aRow(i) Then
      Rows(i & ":" & i).Insert Shift:=xlUp
      Rows(i + 1 & ":" & i + 1).Copy Rows(i & ":" & i)
    End If
  Next i
  Range("A" & i + 1).Select
  Erase aRow: Set Rng = Nothing: Set RngEx = Nothing: Set iRow = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Hay quá Bác ơi, bắt đầu con thấy trong con đã xuất hiện 'ReDim Preserve' ahihi.
Con cảm ơn Bác @HieuCD
 
Upvote 0
chào các anh chị. Em có file dữ liệu mà hiện tại có dòng lệnh này em vẫn chưa hiểu. Mong các anh chị giúp đỡ. Em là newbie. Đang tìm hiểu nên có gì anh chị chỉ dẫn giúp em nhé. Em cảm ơn ạ.
Sub InsertBottomRow(AccountFrame)
Set ARange = Range(AccountFrame)
Application.ScreenUpdating = False
ActiveSheet.Unprotect
CntRow = ARange.Rows.Count - 3
ARange.Rows(CntRow).EntireRow.Insert
ARange.Columns(1).Rows(CntRow).Activate
Range("AccountRow").Copy Destination:=ActiveCell
ActiveCell.Offset(0, 2).Value = Range(AccountFrame).Columns(1).Rows(1).Value
ActiveCell.Activate
ActiveSheet.Protect
Application.ScreenUpdating = True
End Sub


Sub InsertRowAtSelection(AccountFrame)
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Set ARange = Range(AccountFrame)
CntRow = ARange.Rows.Count - 3

Set SRange = Range(Range(AccountFrame).Columns(1).Rows(3), Range(AccountFrame).Columns(15).Rows(CntRow))

If (Intersect(ActiveCell, SRange) Is Nothing) Then
MsgBox "Select a white cell within an account.", 0, "Wrong cell!"
Exit Sub
End If

Range("B" & (ActiveCell.Row)).Select
Selection.EntireRow.Insert
Range("AccountRow").Copy Destination:=ActiveCell
ActiveCell.Offset(0, 2).Value = Range(AccountFrame).Columns(1).Rows(1).Value
ActiveCell.Activate
ActiveSheet.Protect
Application.ScreenUpdating = True
End Sub

cái này dùng để thêm dòng vào một khoảng có trước mà em vẫn không làm được.
 
Upvote 0
tototolon_123 đã viết:
chào các anh chị. Em có file dữ liệu mà hiện tại có dòng lệnh này em vẫn chưa hiểu. Mong các anh chị giúp đỡ. Em là newbie. Đang tìm hiểu nên có gì anh chị chỉ dẫn giúp em nhé. Em cảm ơn ạ.
Sub InsertBottomRow(AccountFrame)
Set ARange = Range(AccountFrame)
Application.ScreenUpdating = False
ActiveSheet.Unprotect
CntRow = ARange.Rows.Count - 3
ARange.Rows(CntRow).EntireRow.Insert
ARange.Columns(1).Rows(CntRow).Activate
Range("AccountRow").Copy Destination:=ActiveCell
ActiveCell.Offset(0, 2).Value = Range(AccountFrame).Columns(1).Rows(1).Value
ActiveCell.Activate
ActiveSheet.Protect
Application.ScreenUpdating = True
End Sub


Sub InsertRowAtSelection(AccountFrame)
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Set ARange = Range(AccountFrame)
CntRow = ARange.Rows.Count - 3

Set SRange = Range(Range(AccountFrame).Columns(1).Rows(3), Range(AccountFrame).Columns(15).Rows(CntRow))

If (Intersect(ActiveCell, SRange) Is Nothing) Then
MsgBox "Select a white cell within an account.", 0, "Wrong cell!"
Exit Sub
End If

Range("B" & (ActiveCell.Row)).Select
Selection.EntireRow.Insert
Range("AccountRow").Copy Destination:=ActiveCell
ActiveCell.Offset(0, 2).Value = Range(AccountFrame).Columns(1).Rows(1).Value
ActiveCell.Activate
ActiveSheet.Protect
Application.ScreenUpdating = True
End Sub

cái này dùng để thêm dòng vào một khoảng có trước mà em vẫn không làm được.
Nhấp chuột vào đây để mở rộng...
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?
 
Upvote 0
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

  • 2021 Budget.xlsm
    929.1 KB · Đọc: 3
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

  • 201006_ Dữ liệu bảng tìm kiếm - đối chiếu đơn hàng 2021 - hưởng.xlsm
    3 MB · Đọc: 7
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

  • VBA TÁCH 100 dong trên EXCEL.txt
    1.1 KB · Đọc: 4
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
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

dungluf123
Lỗi khi sử dụng công thức để link từ file này sang file khác của Excel trên hệ thống mạng chung của công ty
Trả lời
0
Đọc
18
dungluf123
dungluf123
V
Tìm điều kiện sau đó tính tổng ma hang theo điều kiện
Trả lời
5
Đọc
46
vnproc
V
hongphuong1997
  • Question
Lấy ký tự trong chuỗi theo nhiều điều kiện
Trả lời
0
Đọc
23
hongphuong1997
hongphuong1997
P
HÀM SUBTOTAL BỊ #VALUE
Trả lời
1
Đọc
24
DeTong
D
phanmoi688
[Xin nhờ giúp đỡ] Tìm cách xóa các ký tự trắng trong biểu
Trả lời
4
Đọc
44
phanmoi688
phanmoi688
Xem thêm…

Facebook

Giaiphapexcel.com

Group

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

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