thao nguyen01
Thành viên thường trực
- Tham gia
- 8/12/19
- Bài viết
- 214
- Được thích
- 25
Kính gửi anh/chị trên diễn đàn,
Em bị vướng vấn đề tách sheet như sau ạ: Em muốn tách sheet dựa vào đơn vị và khách hàng. Nếu từng đơn vị gắn với mỗi khách hàng (cột J và K) trùng với ô D2 và D3 thì sẽ lọc ra, sau đó tách sheet tương ứng
Em có ví dụ sheet Chi nhánh A-Nguyễn Tuấn Anh. Tương tự sẽ là Chi nhánh A-Trần Thanh Bình
Anh/chị xem giúp em ạ. Em cảm ơn anh/chị nhiều ạ.
Em bị vướng vấn đề tách sheet như sau ạ: Em muốn tách sheet dựa vào đơn vị và khách hàng. Nếu từng đơn vị gắn với mỗi khách hàng (cột J và K) trùng với ô D2 và D3 thì sẽ lọc ra, sau đó tách sheet tương ứng
Mã:
Sub baocao()
Dim i As Long
Dim k As Long
Dim dcuoi As Long
Dim arr_N()
Dim arr_D()
Dim kh As String
Dim donvi As String
dcuoi = Sheet1.Range("A1000").End(xlUp).Row
arr_N = Sheet1.Range("A3:G" & dcuoi)
ReDim arr_D(1 To UBound(arr_N, 1), 1 To 7)
kh = Sheet2.Range("D3")
donvi = Sheet2.Range("D2")
For i = 1 To UBound(arr_N, 1)
If arr_N(i, 2) = donvi And arr_N(i, 3) = kh Then
k = k + 1
'arr_D(k, 1) = k
arr_D(k, 1) = arr_N(i, 1)
arr_D(k, 2) = arr_N(i, 2)
arr_D(k, 3) = arr_N(i, 3)
arr_D(k, 4) = arr_N(i, 4)
arr_D(k, 5) = arr_N(i, 5)
arr_D(k, 6) = arr_N(i, 6)
arr_D(k, 7) = arr_N(i, 7)
End If
Next
Sheet2.Range("A6:G1000").Clear
Sheet2.Range("A6").Resize(k, 7) = arr_D
End Sub
Sub tachsheet()
Dim i As Long
Dim k As Long
Dim arr_DS()
Dim arr_DS02()
Dim arr_D()
Dim dcuoi As Long
Dim dcuoi02 As Long
Dim sh As Worksheet
Application.DisplayAlerts = False
dcuoi = Sheet2.Range("J1000").End(xlUp).Row
arr_DS = Sheet2.Range("J2:J" & dcuoi)
dcuoi02 = Sheet2.Range("K10000").End(xlUp).Row
arr_DS02 = Sheet2.Range("K2:K" & dcuoi02)
For Each sh In Worksheets
If sh.Name <> "data" And sh.Name <> "bao cao" Then
sh.Delete
End If
Next
For i = 1 To UBound(arr_DS, 1)
For j = 1 To UBound(arr_DS02, 1)
If Sheet2.Range("D2") = arr_DS(i, 1) And Sheet2.Range("D3") = arr_DS02(j, 1) Then
Call baocao
Sheet2.Copy before:=Sheet2
ActiveSheet.Name = arr_DS(i, 1) & "_" & arr_DS02(j, 1)
Sheet2.Activate
End If
Next
Next
Application.DisplayAlerts = False
End SubAnh/chị xem giúp em ạ. Em cảm ơn anh/chị nhiều ạ.
