Hỏi về cách biến đổi cấu trúc dữ liệu của bảng chấm công? (1 người xem)

[KUMI]

Em chào mọi người ạ!
Em có một câu hỏi về phần công thức đã được GPE chỉ giúp rồi ạ. Nhưng em vẫn cảm thấy chưa hoàn hảo cho nhu cầu công việc lắm.

Do vậy em xin gửi lại file lên một lần nữa để nhờ các Thầy cùng các Anh Chị nghiên cứu thêm một lần nữa để xem có cách nào giúp em ra được kết quả cuối cùng không ạ?

Cụ thể mọi thắc mắc và dẫn chứng minh họa em để trong file kèm.
GPE xem và giúp đỡ em với ạ!
Em xin cảm ơn!

 

[SA_DQ]

Bạn xem trong file với những biển đổi nhỏ như sau:

 

[KUMI]

Hix! Đúng là với file em đưa ra thì trên cả sự mong đợi ạ! Em cảm ơn Thầy ạ!
Nhưng thật sự em chưa đủ kiến thức để hiểu code của Thầy:

Sub GPECongOm()
 Dim jJ As Long, Rws As Long, Ngay As Byte, Ww As Byte
 Const Om As String = "OM"
 
 Rws = [H65500].End(xlUp).Row 'Đây là gì...?
 [b25].CurrentRegion.Offset(1, 1).Clear 'Đây là gì...?
 For jJ = 5 To Rws Step 3 'Đây là gì...?
    For Ww = 1 To 31 
        If Month([g4].Offset(, Ww).Value) <> [f3].Value Then Exit For 'Đây là gì...?
        With Cells(jJ, "G").Offset(, Ww) 'Đây là gì...?
            If .Offset(, -1).Value <> Om And .Value = Om Then
                [B999].End(xlUp).Offset(1).Value = Cells(jJ, "F").Value 'Đây là gì...?
                [B999].End(xlUp).Offset(, 1).Resize(, 2).Value = Day([g4].Offset(, Ww).Value) 'Đây là gì...?
                
            ElseIf .Value = Om And .Offset(, 1).Value <> Om Then
                [B999].End(xlUp).Offset(, 2).Value = Day([g4].Offset(, Ww).Value) 'Đây là gì...?
            End If
        End With
    Next Ww
 Next jJ
 Randomize 'Đây là gì...?
 [a24].Resize(, 4).Interior.ColorIndex = 34 + 9 * Rnd() \ 1 'Đây là gì...?
End Sub

Phiền Thầy và các chuyên gia hiểu biết giải thích từng dòng Code của Thầy Quang Sa giúp em để em dễ vẫn dụng trong từng trường hợp kiểu như em đã chú thích bên cạnh code với ạ.
Một lần nữa Em xin cảm ơn GPE!
----------
Không ngờ Thầy vui tính thật!

 

[SA_DQ]

Sub GPECongOm()
  Dim jJ As Long, Rws As Long, Ngay As Byte, Ww As Byte 
 Const Om As String = "OM" 

 Rws = [H65500].End(xlUp).Row '1 Đây là gì...?' 
 [b25].CurrentRegion.Offset(1, 1).Clear '2 Đây là gì...?'
  For jJ = 5 To Rws Step 3 '3 Đây là gì...?' 
     For Ww = 1 To 31         
          If Month([g4].Offset(, Ww).Value)  [f3].Value Then Exit For '4 Đây là gì...?'
               With Cells(jJ, "G").Offset(, Ww) '5 Đây là gì...?'           
                    If .Offset(, -1).Value  Om And .Value = Om Then  
                        [B999].End(xlUp).Offset(1).Value = Cells(jJ, "F").Value '6 Đây là gì...?'     
           [B999].End(xlUp).Offset(, 1).Resize(, 2).Value = Day([g4].Offset(, Ww).Value) '7 Đây là gì...?' 
                    ElseIf .Value = Om And .Offset(, 1).Value  Om Then 
                        [B999].End(xlUp).Offset(, 2).Value = Day([g4].Offset(, Ww).Value) '8 Đây là gì...?'     
                   End If        
              End With
     Next Ww
 Next jJ
 Randomize '9 Đây là gì...?' 
[a24].Resize(, 4).Interior.ColorIndex = 34 + 9 * Rnd() \ 1 '10 Đây là gì...?'

End Sub

D1: Lấy dòng cuối có dữ liệu của cột 'H' gán vô biến đã khai báo;

D2: Xóa dữ liệu do macro chạy lần trước làm ra (giữ lại tiêu đề báo cáo & cột đầu có gán công thức để ghi số thứ tự)

D3: Thiết lập vòng lặp từ dòng 5 cho đến trị gán trong biến Rws (xem D1); Bước nhảy là 3 (các hàng có công ốm)

D4: Khi gặp tháng khác với tháng đang kháo sát (KS) thì thoát (Giành cho các tháng ít hơn 31 ngày) (Xem thêm thiết kế trang tính từ ô [H4] & các ô fải của nó)

D5: Định vị nơi ghi kết quả KS công ốm của từng người;

D6: Ghi tên nhân viên đang KS vô ô khi gặp công ốm;

D7: Ghi ngày ốm vô ô fải liền kề;

D8: Ghi ngày cuối đợt ốm;

D9: Khởi động "Hàm" lấy số ngẫu nhiên;

D10: Tô màu nền cho 4 ô tiêu đề báo cáo; (Nhằm mục đích cho người dùng biết macro đã lập kết quả mới nơi báo cáo)OK?!

 

[KUMI]

Cảm ơn Thầy Đêm nay bé ngủ Em sẽ ngâm cứu hihi!!

 

[KUMI]

Hỏi về cách xử lý cho nhiều Sheet?

Xin Chào Thầy Cô và Anh Chị trong GPE lâu lắm rồi Em mới quay lại bài này.
Ngày Trước Thầy DQ_SA và Thầy HYen17 đã tận tình giúp đỡ để Em áp dụng bài này vào công việc rât thành công.
Nhưng hiện tại các bảng chấm công của các bộ phận Em đã gộp lại vao một Sheet và cho một người quản lý công việc này.Nhưng code bài này khá phức tạp em làm mãi mà không thể viết code để làm sao nó có thể thực hiện trên toàn bộ các Sheet chấm công trong file kèm: cụ thể là từ Sheets(1) đến Sheets(5).
Thầy cô và Anh Chị trong GPE giúp đỡ Em về vấn đề này với ạ!
Em xin cảm ơn!

 

[dhn46]

Xin Chào Thầy Cô và Anh Chị trong GPE lâu lắm rồi Em mới quay lại bài này.
Ngày Trước Thầy DQ_SA và Thầy HYen17 đã tận tình giúp đỡ để Em áp dụng bài này vào công việc rât thành công.
Nhưng hiện tại các bảng chấm công của các bộ phận Em đã gộp lại vao một Sheet và cho một người quản lý công việc này.Nhưng code bài này khá phức tạp em làm mãi mà không thể viết code để làm sao nó có thể thực hiện trên toàn bộ các Sheet chấm công trong file kèm: cụ thể là từ Sheets(1) đến Sheets(5).
Thầy cô và Anh Chị trong GPE giúp đỡ Em về vấn đề này với ạ!
Em xin cảm ơn!

Bạn giữ nguyên Sub của bác Sa và cho duyệt 1 vòng qua các sheet là xong

Sub TongHop()
Dim Arr, Item
Arr = Array("PC", "QC", "KT", "NS", "KHO")
For Each Item In Arr
    Sheets(Item).Select
    GPECongOm
Next
End Sub

Nếu muốn không nháy nháy thì chú ý thêm dòng lệnh

Sub TongHop()
Application.ScreenUpdating = False


............................
Application.ScreenUpdating = True
End Sub

 

[KUMI]

Xin Chào Thầy Cô và Anh Chị trong GPE!
ở bài #2 của Thầy SA đã giúp đỡ Em đạt được kết quả như Em mong muốn. Tuy nhiên Em thấy cần tiếp tục cải tiến thêm để có kết quả ưng ý hơn.
Cụ thể như thế này ạ!

Với bảng dữ liệu như thế này:


Sau khi chạy code của Thầy SA xong thì kết quả đúng như Em muốn sẽ ra như thế này ạ



Và trong quá trình nhập liệu thực tế thì dữ liệu của Em có lúc bị kiểu này ạ (khôg liên tục)



Và vẫn chạy code đó kết quả như thế này :


Nghĩa dữ liệu ngày OM(ốm) trên bảng công là vẫn có nhưng kết quả thu gọn lại không hiển thị
Đây là vấn đề Em muốn khắc phục ạ!

code của Thầy SA như ở trên là như thế này (Em viết xuống đây để dễ theo dõi):

Sub GPECongOm()
 Dim jJ As Long, Rws As Long, Ngay As Byte, Ww As Byte
 Const Om As String = "OM"
 
 Rws = [H65500].End(xlUp).Row ' Nguyên nhân lỗi không ra kết quả 
 [b25].CurrentRegion.Offset(1, 1).Clear
 For jJ = 5 To Rws Step 3
    For Ww = 1 To 31
        If Month([g4].Offset(, Ww).Value) <> [f3].Value Then Exit For
        With Cells(jJ, "G").Offset(, Ww)
            If .Offset(, -1).Value <> Om And .Value = Om Then
                [B999].End(xlUp).Offset(1).Value = Cells(jJ, "F").Value
                [B999].End(xlUp).Offset(, 1).Resize(, 2).Value = Day([g4].Offset(, Ww).Value)
                
            ElseIf .Value = Om And .Offset(, 1).Value <> Om Then
                [B999].End(xlUp).Offset(, 2).Value = Day([g4].Offset(, Ww).Value)
            End If
        End With
    Next Ww
 Next jJ
 Randomize
 [a24].Resize(, 4).Interior.ColorIndex = 34 + 9 * Rnd() \ 1
End Sub

Em cũng vằn vọc mãi và nghĩ nguyên nhân là ở dòng này

 Rws = [H65500].End(xlUp).Row

Nhưng vẫn chưa biết sửa lại thế nào để ra kết quả theo ý muốn.
Để đỡ mất nhiều thời gian và đặc biệt là để tránh khỏi các lỗi có thể xảy ra sau này nên Em gửi bài lên đây nhờ Thầy Cô và Anh Chị giúp đỡ ạ!
Có phải nguyên nhân như em nêu trên không ạ? và có cách viết nào khác để đảm bảo vẫn ra kết quả theo ý muốn không ạ!
Mong lại được nhận giúp đỡ từ GPE!
Xin cảm ơn!

 

[ndu96081631]

Để đỡ mất nhiều thời gian và đặc biệt là để tránh khỏi các lỗi có thể xảy ra sau này nên Em gửi bài lên đây nhờ Thầy Cô và Anh Chị giúp đỡ ạ!
Có phải nguyên nhân như em nêu trên không ạ? và có cách viết nào khác để đảm bảo vẫn ra kết quả theo ý muốn không ạ!
Mong lại được nhận giúp đỡ từ GPE!
Xin cảm ơn!

Tôi không cải tiến gì với code cũ mà viết lại toàn bộ:
1> Code chính:

Function FindSpecDays(ByVal Table As Range, ByVal Lookup_Value As String)
  Dim arr(), aTable
  Dim lR As Long, lC As Long, n As Long
  Dim tmpR As String, tmpC As String
  Dim bChk As Boolean
  On Error Resume Next
  aTable = Table.Value
  For lR = 2 To UBound(aTable, 1)
    tmpR = CStr(aTable(lR, 1))
    If Len(tmpR) Then
      For lC = 3 To UBound(aTable, 2)
        tmpC = UCase(aTable(lR, lC))
        If tmpC = UCase(Lookup_Value) Then
          n = n - (bChk = False)
          ReDim Preserve arr(1 To 4, 1 To n)
          arr(1, n) = n
          arr(2, n) = tmpR
          If arr(3, n) = vbNullString Then arr(3, n) = CLng(aTable(1, lC))
          arr(4, n) = CLng(aTable(1, lC))
          bChk = True
        Else
          bChk = False
        End If
      Next
    End If
  Next
  If n Then FindSpecDays = Transpose2DArray(arr)
End Function
Private Function Transpose2DArray(ByVal arr2D)
  Dim arr(), aTemp
  Dim lR As Long, lC As Long
  On Error Resume Next
  aTemp = arr2D
  ReDim arr(LBound(aTemp, 2) To UBound(aTemp, 2), LBound(aTemp, 1) To UBound(aTemp, 1))
  For lR = LBound(aTemp, 1) To UBound(aTemp, 1)
    For lC = LBound(aTemp, 2) To UBound(aTemp, 2)
      arr(lC, lR) = aTemp(lR, lC)
    Next
  Next
  Transpose2DArray = arr
End Function

2> Áp dụng:

Sub Main()
  Dim Table As Range, Target As Range, Search As String, arr
  [COLOR=#ff0000]Set Table = Sheet1.Range("F4:AL19")[/COLOR] '<--- Khai báo vùng dữ liệu
  [COLOR=#ff0000]Set Target = Sheet1.Range("A25") [/COLOR]   '<--- Nơi đặt kết quả
  [COLOR=#ff0000]Search = "OM"    [/COLOR]                   '<--- Từ khóa dò tìm
  arr = FindSpecDays(Table, Search)
  If IsArray(arr) Then
    Target.Resize(1000, 4).ClearContents
    With Target.Resize(UBound(arr, 1), UBound(arr, 2))
      .Value = arr
      .Offset(, 2).Resize(, 2).NumberFormat = "dd/mm/yyyy"
    End With
  End If
End Sub

Chuyện bạn cần làm là tùy biến 3 dòng code màu đỏ cho phù hợp với dữ liệu thật: Khai báo vùng dữ liệu + Nơi đặt kết quả + Từ khóa dò tìm ("OM")
Vậy là xong! Mọi code khác để nguyên
Chạy thử xem nhé

 

[KUMI]

Sub Main()
  Dim Table As Range, Target As Range, Search As String, arr
  [COLOR=#ff0000]Set Table = Sheet1.Range("F4:AL19")[/COLOR] '<--- Khai báo vùng dữ liệu
  [COLOR=#ff0000]Set Target = Sheet1.Range("A25") [/COLOR]   '<--- Nơi đặt kết quả
  [COLOR=#ff0000]Search = "OM"    [/COLOR]                   '<--- Từ khóa dò tìm
  arr = FindSpecDays(Table, Search)
  If IsArray(arr) Then
    Target.Resize(1000, 4).ClearContents
    With Target.Resize(UBound(arr, 1), UBound(arr, 2))
      .Value = arr
      .Offset(, 2).Resize(, 2).NumberFormat = "dd/mm/yyyy"
    End With
  End If
End Sub

Hi,Thầy! Con rất thích những kiểu Sub main của Thầy như vậy đấy thật dễ áp dụng và mang lại hiệu quả cao.
Tuy nhiên ở bài này con vẫn còn một thắc mắc là không hiểu cái cột tên của Thầy code của nó nằm ở đoạn nào ạ.
Để con làm chủ được nó khi bảng dữ liệu có sự thay đổi.
Ví dụ con muốn thay cho cột tìm tên vào đó là Mã số thì phải sửa code ở đâu ạ?
Hoặc là con muốn thêm một cột mã số sau cột TT nữa chẳng hạn.
Thầy có thể chú thích thêm cho con biết về những dòng code của 2 Function trên như ở bài #4 không ạ?
Cảm ơn Thầy rất nhiều!

 

[ndu96081631]

Hi,Thầy! Con rất thích những kiểu Sub main của Thầy như vậy đấy thật dễ áp dụng và mang lại hiệu quả cao.
Tuy nhiên ở bài này con vẫn còn một thắc mắc là không hiểu cái cột tên của Thầy code của nó nằm ở đoạn nào ạ.
Để con làm chủ được nó khi bảng dữ liệu có sự thay đổi.
Ví dụ con muốn thay cho cột tìm tên vào đó là Mã số thì phải sửa code ở đâu ạ?
Hoặc là con muốn thêm một cột mã số sau cột TT nữa chẳng hạn.
Thầy có thể chú thích thêm cho con biết về những dòng code của 2 Function trên như ở bài #4 không ạ?
Cảm ơn Thầy rất nhiều!

Bạn nhìn chổ này:

[COLOR=#ff0000]For lR = [/COLOR][B][COLOR=#0000cd]2[/COLOR][/B][COLOR=#ff0000] To UBound(aTable, 1)[/COLOR] ''<---- Duyệt từ trên xuống, tính từ dòng thứ [B][COLOR=#0000cd]2[/COLOR][/B] (bỏ qua tiêu đề)
    tmpR = CStr(aTable(lR, 1)) ''<---- Lấy giá trị của cột thứ nhất
    If Len(tmpR) Then
      [COLOR=#ff0000]For lC = [/COLOR][COLOR=#0000cd][B]3[/B][/COLOR][COLOR=#ff0000] To UBound(aTable, 2) [/COLOR][COLOR=#000000]''[/COLOR]<---- Duyệt ngang sang phải, tính từ cột thứ [COLOR=#0000cd][B]3[/B][/COLOR]

Đó là vì dữ liệu của bạn như thế nên tôi phải làm thế
Ngay từ đầu tôi đã lường trước sẽ có tình huống này (đòi hỏi thêm gì đó) nên tôi định làm ở mức tổng quát hơn nữa: Code tự nhận biết đâu là dòng chứa ngày tháng... nhưng mà thế thì... QUÁ CỰC đi nên tạm thời chỉ làm đến mức đó thôi
Cũng vì những lý do trên mà ngay từ đầu tôi không tham gia. Lý do vì tính tôi thích viết code dạng tổng quát để có thể áp dụng nhiều lần
-------------------
Vậy có yêu cầu gì bạn cứ liệt kê hết, chúng ta sẽ từ từ bàn
Tuy nhiên vẫn phải nhắc nhở 1 câu: Đã là cơ sở dữ liệu thì bạn phải CHUẨN HÓA. Không thể nay thế này, mai lại đổi khác

 

[KUMI]

Đó là vì dữ liệu của bạn như thế nên tôi phải làm thế
Ngay từ đầu tôi đã lường trước sẽ có tình huống này (đòi hỏi thêm gì đó) nên tôi định làm ở mức tổng quát hơn nữa: Code tự nhận biết đâu là dòng chứa ngày tháng... nhưng mà thế thì... QUÁ CỰC đi nên tạm thời chỉ làm đến mức đó thôi

Cảm ơn Thầy rất nhiều!
Con hiểu những khó khăn cực nhọc khi đụng phải bài viết này (qua mấy cái biểu tượng hình người toát mồ hôi của Thầy DQ_SA con đã cảm nhận được điều này).
Ngay từ ngày đầu khi mới gửi bài này nên con cũng có cảm nhận đây không phải là một bài toán có thể giải quyết dễ dàng được với những người ở mức lập trình nâng cao.
Thậm trí con đã có suy nghĩ định không gửi bài này lên vì xác định có thể thể không có kết quả gì...nhưng thời điểm đó con cũng hay truy cập GPE ngoài vấn đề này ra cũng không biết là lên hỏi gi và học gì nữa. Vì vậy con mới thay đổi suy nghĩ dù sao nhiều cái đầu cũng hơn một cái mà trong khi đó kiến thức của con còn chưa biết gì làm sao dám khẳng định là không có kết quả gì được..
không ngờ sự việc còn diễn ra hơn cả những gì con mong muốn.
Cảm ơn GPE!

Tuy nhiên vẫn phải nhắc nhở 1 câu: Đã là cơ sở dữ liệu thì bạn phải CHUẨN HÓA. Không thể nay thế này, mai lại đổi khác

Vấn đề này đúng là con không thể kiểm soát được chủ yếu là do Sếp và tình hình từng thời kỳ thôi ạ!
Nhưng vấn đề con muô'n ở đây là hiểu hoàn toàn được cái hàm tự tạo của Thầy để có thể làm chủ được nó và có thể phát triển nó vào vấn đề nào đó sau này chẳng hạn vì đợt này con thấy Thầy hay viết kiểu này để có thể mang lại hiệu quả cao.
Chứ không phải là con có suy nghĩ làm khó hay là thách thức mọi người đâu ạ!
Rất cảm ơn Thầy!

 

[KUMI]

Bạn nhìn chổ này:

[COLOR=#ff0000]For lR = [/COLOR][B][COLOR=#0000cd]2[/COLOR][/B][COLOR=#ff0000] To UBound(aTable, 1)[/COLOR] ''<---- Duyệt từ trên xuống, tính từ dòng thứ [B][COLOR=#0000cd]2[/COLOR][/B] (bỏ qua tiêu đề)
    tmpR = CStr(aTable(lR, 1)) ''<---- Lấy giá trị của cột thứ nhất
    If Len(tmpR) Then
      [COLOR=#ff0000]For lC = [/COLOR][COLOR=#0000cd][B]3[/B][/COLOR][COLOR=#ff0000] To UBound(aTable, 2) [/COLOR][COLOR=#000000]''[/COLOR]<---- Duyệt ngang sang phải, tính từ cột thứ [COLOR=#0000cd][B]3[/B][/COLOR]

Cảm ơn Thầy,Con hiểu rồi!
Nếu muốn lấy thông tin cột mã số thì:

Function FindSpecDays(ByVal Table As Range, ByVal Lookup_Value As String)
  Dim arr(), aTable
  Dim lR As Long, lC As Long, n As Long
  Dim tmpR As String, tmpC As String
  Dim bChk As Boolean
  On Error Resume Next
  aTable = Table.Value
  For lR = 2 To UBound(aTable, 1)
    tmpR = CStr(aTable(lR, 1))
    If Len(tmpR) Then
      For lC = [COLOR=#ff0000][I][B]3[/B][/I][/COLOR] To UBound(aTable, 2)
        tmpC = UCase(aTable(lR, lC))
        If tmpC = UCase(Lookup_Value) Then
          n = n - (bChk = False)
          ReDim Preserve arr(1 To 4, 1 To n)
          arr(1, n) = n
          arr(2, n) = tmpR
          If arr(3, n) = vbNullString Then arr(3, n) = CLng(aTable(1, lC))
          arr(4, n) = CLng(aTable(1, lC))
          bChk = True
        Else
          bChk = False
        End If
      Next
    End If
  Next
  If n Then FindSpecDays = Transpose2DArray(arr)
End Function

Sửa 3 thành 4.
và :

Sub Main()
  Dim Table As Range, Target As Range, Search As String, arr
  Set Table = Sheet1.Range("[COLOR=#ff0000][I][B]F[/B][/I][/COLOR]4:AL19")[COLOR=#008000] '<--- Khai báo vùng dữ liệu[/COLOR]
  Set Target = Sheet1.Range("A25")   [COLOR=#008000] '<--- Nơi đặt kết quả[/COLOR]
  Search = "OM"                       [COLOR=#008000]'<--- Từ khóa dò tìm[/COLOR]
  arr = FindSpecDays(Table, Search)
  If IsArray(arr) Then
    Target.Resize(1000, 4).ClearContents
    With Target.Resize(UBound(arr, 1), UBound(arr, 2))
      .Value = arr
      .Offset(, 2).Resize(, 2).NumberFormat = "dd/mm/yyyy"
    End With
  End If
End Sub

Sửa F thành E.

khà khà!
Nhưng thật sự con vẫn muốn Thầy chú thích thêm về 2 cái hàm tự tạo đó. Mục đích hiện giờ của con chỉ là học để vận dụng chứ không phải là để giải quyết cho bảng chấm công này nữa.Khi nào ngồi chán Thầy thấy nghứa tay thì Thầy chú thích thêm vào các dòng còn lại giúp con nhé...hihi
Cảm ơn Thầy!

 

[ndu96081631]

Cảm ơn Thầy,Con hiểu rồi!
Nếu muốn lấy thông tin cột mã số thì:

Sửa 3 thành 4.
và :

Sửa F thành E.

Rất xuất sắc!
Chuyện rất đơn giản đối với dân biết lập trình nhưng với những người mới học như bạn thì đây quả là 1 cố gắng rất lớn. Bạn tự làm, dù chỉ 1 chút thôi cũng giúp ích rất nhiều cho việc tư duy thuật toán sau này
------------------------
Giờ giả sự muốn lấy luôn cột TÊN và MÃ, ta sửa thế này:

Function FindSpecDays(ByVal Table As Range, ByVal Lookup_Value As String)
  Dim arr(), aTable
  Dim lR As Long, lC As Long, n As Long
  Dim tmpR As String, tmpC As String
  Dim bChk As Boolean
  On Error Resume Next
  aTable = Table.Value
  For lR = 2 To UBound(aTable, 1)
    tmpR = CStr(aTable(lR, 1))
    If Len(tmpR) Then
      For lC = [COLOR=#ff0000]4[/COLOR] To UBound(aTable, 2)
        tmpC = UCase(aTable(lR, lC))
        If tmpC = UCase(Lookup_Value) Then
          n = n - (bChk = False)
          ReDim Preserve arr([COLOR=#ff0000]1 To 5[/COLOR], 1 To n)
          arr(1, n) = n
          arr(2, n) = tmpR
         [COLOR=#0000cd] arr(3, n) = aTable(lR, 2)[/COLOR]
          If [COLOR=#ff0000]arr(4, n)[/COLOR] = vbNullString Then [COLOR=#ff0000]arr(4, n)[/COLOR] = CLng(aTable(1, lC))
          [COLOR=#ff0000]arr(5, n)[/COLOR] = CLng(aTable(1, lC))
          bChk = True
        Else
          bChk = False
        End If
      Next
    End If
  Next
  If n Then FindSpecDays = Transpose2DArray(arr)
End Function

Sub Main()
  Dim Table As Range, Target As Range, Search As String, arr
  Set Table = Sheet1.Range("[COLOR=#ff0000]E[/COLOR]4:AL19") '<--- Khai báo vùng du+~ lie^.u
  Set Target = Sheet1.Range("A25")    '<--- No+i ?a(.t ke^'t qua?
  Search = "OM"                       '<--- Tu+` khóa dò tìm
  arr = FindSpecDays(Table, Search)
  If IsArray(arr) Then
    Target.Resize(1000, [COLOR=#ff0000]5[/COLOR]).ClearContents
    With Target.Resize(UBound(arr, 1), UBound(arr, 2))
      .Value = arr
      .[COLOR=#ff0000]Offset(, 3)[/COLOR].Resize(, 2).NumberFormat = "dd/mm/yyyy"
    End With
  End If
End Sub

(chổ màu xanh là thêm vào, chổ màu đỏ là những chổ sửa lại)
Chạy thử code, so sánh kết quả cũ và mới, so sánh code cũ và mới rồi... "ngộ" được cái gì hay cái nấy
Ẹc... Ẹc...

 

[KUMI]

Giờ giả sự muốn lấy luôn cột TÊN và MÃ, ta sửa thế này:

(chổ màu xanh là thêm vào, chổ màu đỏ là những chổ sửa lại)

Cảm ơn Thầy! Thầy rất hiểu tâm tư của con.Đó cũng là vấn đề con đang định hỏi...hihi!