Ronaldinho7
Zl: 0707315985
- Tham gia
- 5/4/22
- Bài viết
- 186
- Được thích
- 204
Xin chào Anh/Chị
Theo yêu cầu của 1 bạn @tieuanhkiet xuất dữ liệu từ sheet tổng ra các sheet con (theo nhà cung cấp), mình có code bên dưới.
Code cho ra kết quả nhưng hình như bị dườm dà.
Nhờ Anh/Chị hướng dẫn cách rút gọn Code mà vẫn đảm bảo được kết quả.
Rất cảm ơn Anh/Chị
Trân trọng!
Theo yêu cầu của 1 bạn @tieuanhkiet xuất dữ liệu từ sheet tổng ra các sheet con (theo nhà cung cấp), mình có code bên dưới.
Code cho ra kết quả nhưng hình như bị dườm dà.
Nhờ Anh/Chị hướng dẫn cách rút gọn Code mà vẫn đảm bảo được kết quả.
Rất cảm ơn Anh/Chị
Trân trọng!
Mã:
Option Explicit
Sub Chia_Ncc_1() '1 sheet
Dim Ws As Worksheet, Dict As Object, a&, b&, Ncc$, f&
Dim i&, j&, k&, Lr&, Lrs&, Arr(), Res(), Str$, l&
Set Dict = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
On Error Resume Next
l = Sheets.Count
For Each Ws In Worksheets
If l > 1 And Ws.Name <> "NhapVatTu" Then
Ws.Delete
End If
Application.DisplayAlerts = False
Next
With Sheet1
Lr = .Range("B" & Rows.Count).End(xlUp).Row
Arr = .Range("A3:I" & Lr).Value
For i = 2 To Lr - 2
If Str <> Arr(i, 2) And Not Dict.exists(Arr(i, 2)) Then
Dict.Add Arr(i, 2), i
Str = Arr(i, 2)
Worksheets.Add after:=Sheet1
ActiveSheet.Name = Str
Range("A1:C1").Value = .Range("A3:C3").Value
Range("D1:H1").Value = .Range("e3:I3").Value
Range("A1:H1").Font.Bold = True
End If
Next i
End With
For Each Ws In Worksheets
If Ws.Name <> "NhapVatTu" Then
ReDim Res(1 To UBound(Arr), 1 To 8)
For a = 2 To UBound(Arr)
If Arr(a, 2) = Ws.Name Then
f = f + 1
For b = 1 To 3
Res(f, b) = Arr(a, b)
Next b
For j = 4 To 8
Res(f, j) = Arr(a, j + 1)
Next j
End If
Next a
End If
If Ws.Name <> "NhapVatTu" Then
Ws.Range("A2").Resize(UBound(Arr), 8).Value = Res
Lrs = Ws.Range("B" & Rows.Count).End(xlUp).Row
Ws.Range("A2:A" & Lrs).NumberFormat = "m/d/yyyy"
Ws.Range("A1:H" & Lrs).Borders.LineStyle = xlContinuous
End If
f = 0
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set Dict = Nothing
Ws = Nothing
End Sub
