Sub tt()
Dim phong As Range
[v8].Value = [F5].Value
Set phong = [T2:T5].Find([f6], , , xlWhole)
[w8:w16].Value = Application.WorksheetFunction.Transpose(phong.Offset(, 3).Resize(, 10).Value)
Sheet1.[A1:AM1000].AdvancedFilter 1, Sheet2.[V7].Resize([W1000].End(3).Row - 6, 2)
Sheet3.Cells.ClearContents
Sheet1.[a1].CurrentRegion.SpecialCells(12).Copy Sheet3.[a1]
Application.CutCopyMode = False
Sheet1.ShowAllData
End Sub
Thử code này xem sao. Cảm giác rủi nhiều hơn may
Sub QH()
Dim nguon(), I, J, K, kk, N, MaNV, ngay
Dim d As Object, Res(), Res2()
Set d = CreateObject("scripting.dictionary")
nguon = Sheet1.[A1].CurrentRegion.Value
ReDim Res(1 To UBound(nguon), 1 To 49)
ReDim Res2(1 To UBound(nguon), 1 To 49)
ngay = Sheet2.[F5].Value
MaNV = Sheet2.[T:T].Find(Sheet2.[F6], , , 1).Offset(, 1).Resize(, 11).Value
For J = 1 To UBound(MaNV, 2)
If MaNV(1, J) <> "" Then
d.Item(MaNV(1, J)) = ""
End If
Next
For I = 2 To UBound(nguon)
If nguon(I, 29) = ngay And d.exists(nguon(I, 37)) Then
K = K + 1
For N = 1 To 49
Res(K, N) = nguon(I, N)
Next
Else
kk = kk + 1
For N = 1 To 49
Res2(kk, N) = nguon(I, N)
Next
End If
Next
If K > 0 Then Sheet3.[A2].Resize(K, 39) = Res
If kk > 0 Then Sheet4.[A2].Resize(K, 39) = Res2
End SubMình edit code của bạn lại thì chạy ko chuẩn nữa, không chịu copy và paste và sheet4. Những chổ tô đen là mình sửa lại.
Sub tt()
Dim phong As Range
[V8].Value = [F5].Value
Set phong = [B][T3:T5][/B].Find([f6], , , xlWhole)
[w8:[B]w23[/B]].Value = Application.WorksheetFunction.Transpose(phong.Offset(,[B] 2[/B]).Resize(, 10).Value)
Sheet1.[A1:AM1000].AdvancedFilter 1, Sheet2.[[B]V8[/B]].Resize([W1000].End(3).Row - 6, 2)
Sheet4.Cells.ClearContents
Sheet1.[a1].CurrentRegion.SpecialCells(12).Copy [B]Sheet4[/B].[a1]
Application.CutCopyMode = False
End SubSub tt()
Dim phong As Range, datano As Long
Set phong = [T:T].Find([f6], , , xlWhole)
datano = phong.End(2).Column - 21
With Sheet4
.[a1:aw1].Value = Sheet1.[a1:aw1].Value
.[A2:AW60000].Clear
.[aK2].Resize(datano).Value = Application.WorksheetFunction.Transpose(phong.Offset(, 2).Resize(, datano).Value)
.[ac2].Resize(datano).Value = Sheet2.[F5].Value
Sheet1.[A1:AM1000].AdvancedFilter 1, .[a1].Resize(datano, 49)
.[A2:AW60000].Clear
Sheet1.[a1].CurrentRegion.SpecialCells(12).Copy Sheet4.[a1]
End With
Application.CutCopyMode = False
Sheet1.ShowAllData
End Sub Sheet1.[A1:AM1000].AdvancedFilter 1, .[a1].Resize(datano[COLOR=#ff0000] + 1[/COLOR], 49)
