Giúp em Code VB để thay thế các hàm trên các cột (2 người xem)

[tiendo1988]

Rất mong các Thầy, các Pro cùng các AE GPE giúp em code xử lý dữ liệu thay thế cho hàm em đang sử dụng trên các cột.
Em đã mô tả trong file đính kèm.
Giúp em code VB trong 2 Sheet: LTMOI1, NienHanQMT
Các cột trong sheet "LTMOI1" lấy dữ liệu từ NHẬT KÝ ĐIỀU CHỈNH, THAY ĐỔI LỊCH TRỰC, QUÂN SỐ TẠI CÁC MỤC TIÊU THEO YÊU CẦU CỦA KH HOẶC BGĐ trong Sheet "MT"

Nếu có gì chưa hiểu ý em muốn nhờ giúp đỡ thì P/M lại cho em, em sẽ ghi chú rõ hơn.

Em rất mong nhận được sự giúp đỡ trong thời gian sớm nhất.

Xin chân thành cảm ơn!

chúc toàn thể các anh em GPE và khách của GPE kỳ nghỉ 30/4, 1/5 vui!

 

[longlt08]

Chào bạn !
Mình đã xem file của bạn thiết kế. Mình góp ý với bạn như thế này:
- Ý tưởng của bạn thay VBA cho các hàm ở các cột là tốt nhưng khối lượng sẽ rất lớn, chỉ dân IT chính hiệu mới đủ sức giải quyết.
- Bạn nên tận dụng công cụ của excel để giải quyết. Mình nghĩ, bạn nên thiết kế sheet chitiet để ghi chép, cập nhật tât cả vào sheet đó. Sau đó bạn dùng pivotable kết hợp với VBA để tạo ra các báo cáo. Pivottable sẽ tạo ra các báo cáo có khả năng tùy biến cao.
Nếu bạn đồng ý với đề suất này thì mình sẽ giúp đỡ bạn. Liên hệ với mình theo địa chỉ: long_ltl@yahoo.com
Chào bạn !

 

[tiendo1988]

Trước tiên mình cám ơn bạn đã dành thời gian cho topic của mình.
mình thì ko hiểu gì về VBA song mình copy một số đoạn code của các anh em trên mạng.
Do mình thất trên một Workbook, trong các sheet nếu ta sử dụng công thức trong cột của các sheet, nếu dữ liệu nhiều ta sẽ thất dung lượng file lớn lên nhanh, file xử lý chậm... vì vậy tôi muốn nhờ các AE giúp tôi code để xử lý thay cho các hàm mình gõ vào các cells để file xử lý nhanh và nhẹ.
Trân trọng cảm ơn!

 

[SA_DQ]

Được cái nào xào cái nấy!

Dưới đây là 2 macro thay cho 2 hàm tự tạo MaxIf() & FindTwoCondition() của bạn

Sub NgàyAD()
 Dim WF As Object, Sh As Worksheet, Rng As Range, Cls As Range, sRng As Range
 Dim Ngay As Date, Ng0 As Date, MyAdd As String
 
 Set Sh = ThisWorkbook.Worksheets("MT")
 Set Rng = Sh.Range(Sh.[o4], Sh.[o5].End(xlDown))
 Set WF = Application.WorksheetFunction
 Ngay = WF.Min(Rng.Offset(, 2)):                    Sheets("LTMOI1").Select
 For Each Cls In Range([B6], [B6].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If sRng Is Nothing Then
        Cls.Offset(, 1).Value = Ngay
    Else
        Ng0 = Ngay:                                 MyAdd = sRng.Address
        Do
            With sRng.Offset(, 2)
                If .Value > Ng0 Then Ng0 = .Value
            End With
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
        Cls.Offset(, 1).Value = IIf(Ngay < Ng0, Ng0, Ngay)
    End If
 Next Cls
End Sub

Sub QuanSo()
 Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range
 Const Kh As String = "-":                          Dim MyAdd As String
 
 Set Sh = ThisWorkbook.Worksheets("MT"):            Sheets("LTMOI1").Select
 Set Rng = Sh.Range(Sh.[o4], Sh.[o5].End(xlDown))
 For Each Cls In Range([B6], [B6].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If sRng Is Nothing Then
        Cls.Offset(, 2).Value = Kh
    Else
        MyAdd = sRng.Address
        Do
            If Cls.Offset(, 1).Value = sRng.Offset(, 2).Value Then _
                Cls.Offset(, 2).Value = sRng.Offset(, 5).Value
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
 Next Cls
End Sub

Bạn kiểm xem sao, nha!

 

[SA_DQ]

Macro con mang hai dòng máu của cha & mẹ

Sub NgàyHD()
 gpeNgay 2
End Sub

Sub NgàyCT()
 gpeNgay 7
End Sub

[B]Sub gpeNgay(Offs As Byte)[/B]
 Dim WF As Object, Sh As Worksheet, Cls As Range, sRng As Range, Rng As Range
 Dim Ngay As Date, Ng0 As Date, MyAdd As String
 
 Set Sh = ThisWorkbook.Worksheets("MT")
 Set Rng = Sh.Range(Sh.[o4], Sh.[o5].End(xlDown))
 Sheets("LTMOI1").Select
 Set WF = Application.WorksheetFunction
 Ngay = WF.Min(Rng.Offset(, Offs))
 For Each Cls In Range([B6], [B6].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If sRng Is Nothing Then
        Cls.Offset(, (Offs + 1) \ 2).Value = Ngay
    Else
        Ng0 = Ngay:                                 MyAdd = sRng.Address
        Do
            With sRng.Offset(, Offs)
                If .Value > Ng0 Then Ng0 = .Value
            End With
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
        Cls.Offset(, (Offs + 1) \ 2).Value = IIf(Ngay < Ng0, Ng0, Ngay)
    End If
 Next Cls
[B]End Sub[/B]

 

[tiendo1988]

Dưới đây là 2 macro thay cho 2 hàm tự tạo MaxIf() & FindTwoCondition() của bạn

Sub NgàyAD()
 Dim WF As Object, Sh As Worksheet, Rng As Range, Cls As Range, sRng As Range
 Dim Ngay As Date, Ng0 As Date, MyAdd As String
 
 Set Sh = ThisWorkbook.Worksheets("MT")
 Set Rng = Sh.Range(Sh.[o4], Sh.[o5].End(xlDown))
 Set WF = Application.WorksheetFunction
 Ngay = WF.Min(Rng.Offset(, 2)):                    Sheets("LTMOI1").Select
 For Each Cls In Range([B6], [B6].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If sRng Is Nothing Then
        Cls.Offset(, 1).Value = Ngay
    Else
        Ng0 = Ngay:                                 MyAdd = sRng.Address
        Do
            With sRng.Offset(, 2)
                If .Value > Ng0 Then Ng0 = .Value
            End With
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
        Cls.Offset(, 1).Value = IIf(Ngay < Ng0, Ng0, Ngay)
    End If
 Next Cls
End Sub

Sub QuanSo()
 Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range
 Const Kh As String = "-":                          Dim MyAdd As String
 
 Set Sh = ThisWorkbook.Worksheets("MT"):            Sheets("LTMOI1").Select
 Set Rng = Sh.Range(Sh.[o4], Sh.[o5].End(xlDown))
 For Each Cls In Range([B6], [B6].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If sRng Is Nothing Then
        Cls.Offset(, 2).Value = Kh
    Else
        MyAdd = sRng.Address
        Do
            If Cls.Offset(, 1).Value = sRng.Offset(, 2).Value Then _
                Cls.Offset(, 2).Value = sRng.Offset(, 5).Value
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
 Next Cls
End Sub

Bạn kiểm xem sao, nha!

Mình cám ơn bạn đã giúp đỡ.
Ban Cho mình hỏi: 2 đoạn code trên mình đưa vào Sheet hay đưa vào Module để thay 2 hàm tự tạo của minh? và cách dùng của Macro như thế nào?

 

[ChanhTQ@]

Macro cùa HYen17 sẽ fải sửa lại, bạn chờ nha!

Ban Cho hỏi: (1) 2 đoạn code trên mình đưa vào Sheet hay đưa vào Module để thay 2 hàm tự tạo của minh? (2) & cách dùng của Macro như thế nào?

(1) Bạn đưa vô Module cho chắc ăn;

(2) Bạn chạy lần lượt các macro cha & mẹ;
Thật ra cũng có thể gộp chung cha & mẹ này vô làm 1, như

Sub GPE()
     gpeNgay 2
     gpeNgay 7
End Sub

(Bạn thấy đó: Gộp thì mất đi 1 fần tự do!)

 

[tiendo1988]

Sub NgàyHD()
 gpeNgay 2
End Sub

Sub NgàyCT()
 gpeNgay 7
End Sub

[B]Sub gpeNgay(Offs As Byte)[/B]
 Dim WF As Object, Sh As Worksheet, Cls As Range, sRng As Range, Rng As Range
 Dim Ngay As Date, Ng0 As Date, MyAdd As String
 
 Set Sh = ThisWorkbook.Worksheets("MT")
 Set Rng = Sh.Range(Sh.[o4], Sh.[o5].End(xlDown))
 Sheets("LTMOI1").Select
 Set WF = Application.WorksheetFunction
 Ngay = WF.Min(Rng.Offset(, Offs))
 For Each Cls In Range([B6], [B6].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If sRng Is Nothing Then
        Cls.Offset(, (Offs + 1) \ 2).Value = Ngay
    Else
        Ng0 = Ngay:                                 MyAdd = sRng.Address
        Do
            With sRng.Offset(, Offs)
                If .Value > Ng0 Then Ng0 = .Value
            End With
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
        Cls.Offset(, (Offs + 1) \ 2).Value = IIf(Ngay < Ng0, Ng0, Ngay)
    End If
 Next Cls
[B]End Sub[/B]

Cám ơn bác!
Bác hướng dẫn giúp em đoạn code của bác đưa vào đâu? sử dụng đoạn code trên thế nào?
Nếu em không nhầm thì đoạn code trên dùng cho Sheet "LTmoi1"?
Xin cảm ơn,

 

[tiendo1988]

Các bác cho em hỏi: đoạn code của SA_DQ và của HYen17HYen1 đưa vào file như thế nào? em đưa cả 2 đoạn code của HYen17 vào một Module mà không thấy có kết quả gì bên bảng tính cả?
Nhờ các bác hướng dẫn thêm!
xin cảm ơn.

 

[SA_DQ]

Bạn xem trong file đính kèm

Hao tài nguyên với bạn, & vui nhe!


(Sẽ tháo file xuống, 1 khi bạn nhấn 'Thanks' hay đã download)

 

[tiendo1988]

cám ơn bác SA_DQ, em đã tải về, sau khi em thử dữ liệu, thy đổi một thông tin để kiểm tra thì em thấy có một số điểm như sau:
ở sheet "LTMoi1" cột B (cột Mục Tiêu) rỗng, không có dữ liệu thì ở các cột bên vẫn có thông tin.... làm sao để khắc phục, để khi cột B rỗng thì các cột bên cũng rỗng.
thức 2: vẫn ở sheet "LTMOI1", khi em thay đổi lấy ngày ở phần "nhật ký điều chỉnh, thay đổi lịch trưc..." thi ngày thay đổi chưa được cập nhật.
Em phải sửa code trên như thế nào để có thể khắc phục được ạ?


Ở Sheet "NienHanQMT" trong file của em có phần ngày về mục tiêu lấy dữ liệu từ cột "ngày" bên sheet "NKDieuQuan", yêu cầu gần giống với phần ngày AD của bên Sheet "LTMOI1", các bác xem và cho em xin code.

Xin cảm ơn các Bác đã quan tâm và giúp đỡ.

 

[ChanhTQ@]

Sau khi em thử dữ liệu, thay một thông tin để kiểm tra thì em thấy có một số điểm như sau:
(1) ở sheet "LTMoi1" cột B (cột Mục Tiêu) rỗng, không có dữ liệu thì ở các cột bên vẫn có thông tin.... làm sao để khắc phục, để khi cột B rỗng thì các cột bên cũng rỗng.

thứ (2): Vẫn ở sheet "LTMOI1", khi em thay đổi lấy ngày ở phần "nhật ký điều chỉnh, thay đổi lịch trưc..." thi ngày thay đổi chưa được cập nhật.
Em phải sửa code trên như thế nào để có thể khắc phục được ạ?

(3) Ở Sheet "NienHanQMT" trong file của em có phần ngày về mục tiêu lấy dữ liệu từ cột "ngày" bên sheet "NKDieuQuan", yêu cầu gần giống với phần ngày AD của bên Sheet "LTMOI1", các bác xem và cho em xin code.

(1) Ở đây có 2 vấn đề bạn cần lưu í:
(*) Có thể bạn sửa lại hàm trong cột 'B' này, để khi không tìm thấy dữ liệu, hàm sẽ trả về chuỗi rỗng;
(*) Mình đã gộp 3 macro mà bạn đang quan tâm vô làm một, như dưới đây, Bạn copy nó & cho chạy thử xem sao, nha!
Trong đó iêu cầu 1 của bạn đã được thực hiện bằng dòng lệnh có mũi tên

Sub gpeNgay_()
 Dim WF As Object, Sh As Worksheet, Cls As Range, sRng As Range, Rng As Range
 Dim Ngay As Date, Ng0 As Date, Offs As Byte
 Dim MyAdd As String
 
 Set Sh = ThisWorkbook.Worksheets("MT"):            Sheets("LTMOI1").Select
 Set Rng = Sh.Range(Sh.[o4], Sh.[o5].End(xlDown))
 Set WF = Application.WorksheetFunction
 For Offs = 2 To 8 Step 5
    Ngay = WF.Min(Rng.Offset(, Offs))
    For Each Cls In Range([B6], [B6].End(xlDown))
        If Cls.Value = "" Then Exit For             '<=|'
        Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
        If sRng Is Nothing Then
            Cls.Offset(, (Offs + 1) \ 2).Value = Ngay
        Else
            Ng0 = Ngay:                             MyAdd = sRng.Address
            Do
                With sRng.Offset(, Offs)
                    If .Value > Ng0 Then Ng0 = .Value
                End With
                Set sRng = Rng.FindNext(sRng)
            Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
            Cls.Offset(, (Offs + 1) \ 2).Value = IIf(Ngay < Ng0, Ng0, Ngay)
        End If
    Next Cls
 Next Offs
End Sub

(2) Hiện tại chàng 'CHANG HONG' có kết quả tại cột 'C' là #2/15/2012# & cột 'F' là #3/18/2012#;
Ứng với số liệu này, ở trang 'MT' ta có 3 dòng 7..9; Vậy bạn cùng tôi ta thử thêm vô [Q9] ngày #4/30/2012# & tại [V8] à trị #5/1/2012# & chạy macro xem sao!
/(/ếu tại [C7] & [f7] hiện lên các trị tương ứng, nghĩa là bạn mắc thêm tội vu cáo đó nha.

(3) Hãy đợi đấy, trang này chưa đến hồi kết mà, sao sống gấp làm vậy?!

 

[tiendo1988]

Trước hết mình xin cám ơn bạn ChanhTQ,
Mình không hiểu gì nhiều về VB và Macro nên có gì phát biểu hoặc thắc mắc không đúng mong các AE và các bạn bỏ qua và hướng dẫn thêm cho mình (mình ko có ý vu cáo )
Sau khi đọc ý kiến của bạn xong mình xem lại file mò mẫm phần Macro và chọn macro rồi Run thì đoạn code mới có hiệu lực.
Các Bạn cho mình hỏi thêm: Nếu muốn macro tự chạy khi thay đổi dữ liệu bên nhật ký thì ta sửa code thế nào?

 

[SA_DQ]

Đây, xong cho trang tính đầu tiên theo iêu cầu của bạn đó nhe!

Các Bạn cho mình hỏi: Nếu muốn macro tự chạy khi thay đổi dữ liệu bên nhật ký thì ta sửa code thế nào?

Có nhiều cách để chạy 1 macro bất kỳ lúc nào bạn muốn;
Nhưng theo mình bạn nên xài tổ hợp fím tắc đã gán cho macro;
Trong file đính kèm, mình đã gán tổ hợp {CTRL}+{SHIFT}+G để chạy tuần tự 2 macro (& {CTRL}+{SHIFT}+Q để chỉ chạy macro thứ 2 1 cách riêng rẽ.)
Những cách khác để chạy 1 macro, như:

(*) Gắn macro đến 1 nút lệnh;

(*) Macro sự kiện;

(*) . . . .

 

[ChanhTQ@]

Bạn chạy macro dưới đây để có kết qủa tại 'H' của trang 'NienHan...'

Sub NgayVeMucTieu()
 Dim Sh As Worksheet, Rng As Range, WF As Object, Cls As Range, sRng As Range
 Dim Ngay As Date, Dat As Date, Rws As Long
 Dim MyAdd As String
 
 Set Sh = ThisWorkbook.Worksheets("NKDieuQuan"):    Sheets("NienHanQMT").Select
 Set WF = Application.WorksheetFunction
 Set Rng = Sh.Range(Sh.[E6], Sh.[e7].End(xlDown))
 Ngay = WF.Min(Rng) - 1:                            Set WF = Nothing
1 'Lap Danh Sách Ma Nhan Vien Duy Nhát:'
 Rws = [d12].CurrentRegion.Rows.Count
 [d11].Resize(Rws).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[BA1], Unique:=True
 Set Rng = Sh.Range(Sh.[B6], Sh.[B7].End(xlDown))
2' Ghi Ngày Dièu Dong Gàn Nhát:'
 For Each Cls In [BA2].CurrentRegion.Offset(1)
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Do
            With sRng.Offset(, 3)
                If Dat < .Value Then Dat = .Value
            End With
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
    If Dat > Ngay Then
        Cls.Offset(, 1).Value = Dat:                        Dat = Ngay
    End If
 Next Cls
 Set Rng = [d11].Resize(Rws)
3'Ghi Két Qua:' 
 For Each Cls In Range([BA2], [BA2].End(xlDown))
    If Cls.Offset(, 1).Value > Ngay Then
        Set sRng = Rng.Find(Cls.Value, , xlValues)
        If Not sRng Is Nothing Then
            MyAdd = sRng.Address
            Do
                sRng.Offset(, 4).Value = Cls.Offset(, 1).Value
                Set sRng = Rng.FindNext(sRng)
            Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
        End If
    End If
 Next Cls
End Sub

 

[tiendo1988]

Cám ơn bạn "ChanhTQ" và Bạn "HYen17" đã giúp đỡ mình.
Về cơ bản Sheet "LTMOI1" và cột "Ngày Về Mục Tiêu" ở Sheet "NienHanQMT" đã ổn theo yêu cầu trong bài của mình.
- Em muốn Macro của "ChanhTQ" và Bạn "HYen17" sang chế độ tự chạy khi thay đổi dữ liệu gốc mà không phải qua bước Run Macro hay bấm tổ hợp phím tắt... thì em sử thế nào ạ?
ở Sheet "NienHanQMT":
- cột "tổng ngày làm tại mục tiêu" mình dùng hàm "Datedif", còn cột "thời gian làm tại mục tiêu" hiển thị ở dạng: ...năm ... tháng ... ngày thì mình phải sử dụng tới một số cột phụ và các hàm mới ra. Tuy là về mặt kết quả thì như ý Song với dữ liệu nhiều việc dùng các hàm như vậy mình thấy file chạy chậm và tăng dung lượng.
Các Thầy, các AE GPE, Các PRO nghiên cứu giúp em code để giải quyết yêu cầu ở các cột này.

Xin cảm ơn sự quan tâm, giúp đỡ của các bạn.
Rất mong nhận được sự giúp đỡ của các bạn.

 

[SA_DQ]

Tính thời gian tại mục tiêu

Trước tiên bạn đến [BB1] của trang tính & gán cho nó 1 cái tên là 'Nam' & nhập dữ liệu vô nó là " năm " (có 2 khoảng trắng nhe!)
(Việc làm này hầu để có Font tiếng Việt)
Sau đó bạn cho chạy macro sau:

Sub ThoiGianTaiMucTieu()
 Dim Cls As Range, StrC As String
 Dim Rws As Long, Dat As Date, SoNgay As Integer, SoLg As Integer
 Const KC As String = " "
 
 Sheets("NienHanQMT").Select:                           Dat = [i10].Value
 Rws = [D12].CurrentRegion.Rows.Count
 For Each Cls In Range([H12], [H65500].End(xlUp))
    If Cls.Value <> "" Then
        SoNgay = Dat - Cls.Value
        If SoNgay > 364 Then
            SoLg = Int(SoNgay / 365.25)
            StrC = CStr(SoLg) & Range("Nam")       '<=|'
            SoNgay = Int(SoNgay - SoLg * 365.25)
        End If
        If SoNgay >= 30 Then
            SoLg = Int((SoNgay / 30))
            StrC = StrC & CStr(SoLg) & " tháng "
            SoNgay = (SoNgay - SoLg * 30)
        End If
        StrC = StrC & CStr(SoNgay) & " ngày"
    End If
    Cls.Offset(, 1).Value = StrC:                       StrC = ""
 Next Cls
End Sub

(húc thành công!

 

[tiendo1988]

Cám ơn bác "SA_DQ", em đã làm được cột đó rồi.

Xin gửi lời cám ơn tới toàn thể AE GPE.
Em đang từng bước hoàn thiện file của - một phần công việc quản lý nhân sự ở công ty em. Nếu AE nào có cao kiến gì thì góp ý thêm cho em để ngày một hoàn chỉnh hơn. Em không biết gì về VBA, mà học lỏm được vài đoạn code muốn thay đổi nó để phù hợp với bài của mình thì khi được khi không nên đành phải làm phiền tới các AE.
việc em sử dụng toàn bộ công thức và hàm nhập trực tiếp vào các bảng tính thì dung lượng file tăng lên nhanh quá và tốc độ xử lý dữ liệu ì ạch quá.

rất mong sự giúp đỡ của Các thầy, các Pro, các AE GPE trong thời gian tới.
Xin cảm ơn!

 

[tiendo1988]

các thầy, các Pro cùng AE GPE và anh SA_DQ cho em hỏi:
em sử dụng đoạn code của Anh SA_DQ đưa vào file của em, ở Sheet NienHanQMT và sheet nhật ký điều quân vẫn giữ nguyên như trong file em gửi lên nhờ các bác giúp, chỉ khác là file của em đang làm nhiều Sheet dữ liệu hơn, trong các sheet cũng nhiều dữ liệu hơn, sheet nào cũng vài trăm dòng chứa dữ liệu. nhưng ko hiểu vì sao khi chạy ở file em gửi lên nhờ các AE giúp thì chạy ok, chỉ phải chờ trong giây lát, còn khi em đưa đoạn doce đó vào file của mình thì khi chạy Macro em bị tình trạng: Macro cứ chạy hoài không dừng.
em không hiểu vì sao. em chỉ sửa chút síu code trên" " tháng " và " ngày " thì em chuyển vào range("thang") và Range("ngay") giống với range("nam") vì máy em sài cả tiếng Hoa nên khi để nguyên đoạn code đó thì kết quả bị lỗi font.
Sau khi kiên nhẫn chờ đợi thì mất gần 5 phút Macro được chuyển vào file của em mới chạy xong.
Giúp em tìm nguyên nhân và khắc phục lỗi với ạ.
Xin cảm ơn.

 

[ChanhTQ@]

Để có đủ số liệu trên trang tính đó bằng macro, bạn lấy cái này chép đè lên cái cũ

Sub ThoiGianTaiMucTieu()
 Dim Cls As Range, StrC As String
 Dim Rws As Long, Dat As Date, SoNgay As Integer, SoLg As Integer
 Const KC As String = " "
 
 Sheets("NienHanQMT").Select:                           Dat = [i10].Value
 Rws = [D12].CurrentRegion.Rows.Count
 For Each Cls In Range([H12], [H65500].End(xlUp))
    If Cls.Value <> "" Then
        SoNgay = Dat - Cls.Value
        If SoNgay > 364 Then
            SoLg = Int(SoNgay / 365.25)
            StrC = CStr(SoLg) & Range("Nam")
            SoNgay = Int(SoNgay - SoLg * 365.25)
        End If
        If SoNgay >= 30 Then
            SoLg = Int((SoNgay / 30))
            StrC = StrC & CStr(SoLg) & " tháng "
            SoNgay = (SoNgay - SoLg * 30)
        End If
        StrC = StrC & CStr(SoNgay) & " ngày"
        Cls.Offset(, 1).Value = StrC:                   StrC = ""    '***'
        Cls.Offset(, 2).Value = Dat - Cls.Value                      '<=|'
    End If
 Next Cls
End Sub