bạn có thể giải thích cho mình đoạn code này được không bạn, mình đang tập VBA, rất cảm ơn bạn ạ
Sub DS()
Dim erow As Long
Sheet1.Range("R1:R65000").ClearContents
Sheet1.Range("A2:A65000").Copy
Range("R1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
erow = Sheet1.[R6500].End(3).Row
ActiveSheet.Range("$R$1:$R$" & erow).RemoveDuplicates Columns:=1, Header:=xlNo
End Sub
Public Sub LOC()
Dim sArr(), dArr(), i As Long, J As Long, K As Long
Dim NHOM
On Error Resume Next
With Sheet1
sArr = .Range(.[A2], .[A65536].End(xlUp)).Resize(, 5).Value2
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 11)
With Sheet2
NHOM = Sheet1.Range("Q1")
For i = 1 To UBound(sArr, 1)
If sArr(i, 1) = NHOM Then
K = K + 1
For J = 1 To 5
dArr(K, J) = sArr(i, J)
Next J
End If
Next i
.Range("A2:E65000").Borders.LineStyle = xlNone
.Range("A2:E65000").ClearContents
.Range("A2").Resize(K, 5) = dArr
.Range("A2").Resize(K, 5).Borders.LineStyle = xlContinuous
End With
End Sub
Sub tach()
Dim i As Long
Application.ScreenUpdating = False
Call DS
With Sheet1
For i = 1 To Sheet1.Range("R65000").End(3).Row
Sheet1.Range("Q1") = Sheet1.Range("R" & i)
Call LOC
Sheet2.Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "" & .Cells(1, 17)
ActiveWorkbook.Close
Next i
.Range("Q1:R65000").ClearContents
End With
Application.ScreenUpdating = True
End Sub
