Xin giải thích giúp mình nội dung và ý nghĩa của các hàm VBA

Liên hệ QC

manhcuonghg

Thành viên mới
Tham gia
13/5/12
Bài viết
35
Được thích
7
- Như tiêu đề mình mới học vba nên chưa biết ý nghĩa của các hàm dưới đây, mong các thầy và ACE trong diễn đàn chỉ giúp nội dung và ý nghĩa của nó ạ
Sub Tach_Sheet()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim Rng As Range
Dim r As Integer
Dim g As Range

Set ws1 = Sheets("SK_THop")
Set Rng = Range("Vung_Tach")
Application.DisplayAlerts = False
'Trích loc danh sách tù sheet XLNV
Sheets("SK_THop").Select
Rows("1:1").Select
' ws1.Range("B1:B5000").AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=Range( _
"AF2"), Unique:=True
ws1.Range("AG1:AG10000").AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=Range( _
"CP2"), Unique:=True
' r = Cells(Rows.Count, "AF").End(xlUp).Row
r = Cells(Rows.Count, "CP").End(xlUp).Row
'Thiet lap dieu kien loc
'Range("AH2").Value = Range("B1").Value
Range("CQ2").Value = Range("AG1").Value
'Tim du lieu và gán tên cho Sheet mói
For Each g In Range("CP3:CP" & r)
'Tieu chí trích loc
'ws1.Range("AH3").Value = _
"=""="" & " & Chr(34) & g.Value & Chr(34)
ws1.Range("CQ3").Value = _
"=""="" & " & Chr(34) & g.Value & Chr(34)
'Tao sheet moi
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count)
' Canh chièu rong cot cho các sheet mói
Range("C:C,D:D,AG:AG,AK:AK").ColumnWidth = 20
Range("E:F,AY:AY,H:K,N:N,AW:AW,AY:AY,BD:BD,BE:BE").ColumnWidth = 15
Range("E:F,BN:BN,BP:BP,BR:BR,BS:BS,CC:CC").ColumnWidth = 18
Range("P:R,AF:AF,AM:AP,BI:BI,BT:BU").ColumnWidth = 11
Columns("BA:BA").ColumnWidth = 26
Columns("BG:BG").ColumnWidth = 34
Columns("BY:BY").ColumnWidth = 50
Range("BM:BM,CB:CB,CD:CE").ColumnWidth = 22
'dat ten cho sheet moi
wsNew.Name = g.Value
'Láy du lieu vào các sheet
Rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("SK_THop").Range("CQ2:CQ3"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
Call DanhSo
Next
ws1.Select
ws1.Columns("CP:CQ").Delete

Application.DisplayAlerts = True
Sheets("TRANG_CHU").Select
Range("A1").Select
MsgBox "VXUHMCUONG ÐÃ TÁCH SHEET XONG", vbMsgBoxRight, "THÔNG BÁO VXUHMCUONG"
End Sub

Sub DanhSo()
Dim lr As Long
Dim Ws As Worksheet

lr = Range("B" & Rows.Count).End(xlUp).Row
If lr > 1 Then
With Range("A2:A" & lr)
.Cells(1, 1).Value = 1
.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1, Trend:=False
End With
End If
End Sub
Sub Xoa_Sheet()
Application.DisplayAlerts = False
Dim ChuaSheets, sh, XoaSheets
ChuaSheets = Array("TRANG_CHU", "SK_THop", "", "")
For Each sh In Worksheets
XoaSheets = Filter(ChuaSheets, sh.Name, 1)
If UBound(XoaSheets) <> 0 Then
sh.Visible = True
sh.Delete
End If
Next
Application.DisplayAlerts = True
End Sub
 
- Như tiêu đề mình mới học vba nên chưa biết ý nghĩa của các hàm dưới đây, mong các thầy và ACE trong diễn đàn chỉ giúp nội dung và ý nghĩa của nó ạ
Sub Tach_Sheet()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim Rng As Range
Dim r As Integer
Dim g As Range

Set ws1 = Sheets("SK_THop")
Set Rng = Range("Vung_Tach")
Application.DisplayAlerts = False
'Trích loc danh sách tù sheet XLNV
Sheets("SK_THop").Select
Rows("1:1").Select
' ws1.Range("B1:B5000").AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=Range( _
"AF2"), Unique:=True
ws1.Range("AG1:AG10000").AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=Range( _
"CP2"), Unique:=True
' r = Cells(Rows.Count, "AF").End(xlUp).Row
r = Cells(Rows.Count, "CP").End(xlUp).Row
'Thiet lap dieu kien loc
'Range("AH2").Value = Range("B1").Value
Range("CQ2").Value = Range("AG1").Value
'Tim du lieu và gán tên cho Sheet mói
For Each g In Range("CP3:CP" & r)
'Tieu chí trích loc
'ws1.Range("AH3").Value = _
"=""="" & " & Chr(34) & g.Value & Chr(34)
ws1.Range("CQ3").Value = _
"=""="" & " & Chr(34) & g.Value & Chr(34)
'Tao sheet moi
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count)
' Canh chièu rong cot cho các sheet mói
Range("C:C,D:D,AG:AG,AK:AK").ColumnWidth = 20
Range("E:F,AY:AY,H:K,N:N,AW:AW,AY:AY,BD:BD,BE:BE").ColumnWidth = 15
Range("E:F,BN:BN,BP:BP,BR:BR,BS:BS,CC:CC").ColumnWidth = 18
Range("P:R,AF:AF,AM:AP,BI:BI,BT:BU").ColumnWidth = 11
Columns("BA:BA").ColumnWidth = 26
Columns("BG:BG").ColumnWidth = 34
Columns("BY:BY").ColumnWidth = 50
Range("BM:BM,CB:CB,CD:CE").ColumnWidth = 22
'dat ten cho sheet moi
wsNew.Name = g.Value
'Láy du lieu vào các sheet
Rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("SK_THop").Range("CQ2:CQ3"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
Call DanhSo
Next
ws1.Select
ws1.Columns("CP:CQ").Delete

Application.DisplayAlerts = True
Sheets("TRANG_CHU").Select
Range("A1").Select
MsgBox "VXUHMCUONG ÐÃ TÁCH SHEET XONG", vbMsgBoxRight, "THÔNG BÁO VXUHMCUONG"
End Sub

Sub DanhSo()
Dim lr As Long
Dim Ws As Worksheet

lr = Range("B" & Rows.Count).End(xlUp).Row
If lr > 1 Then
With Range("A2:A" & lr)
.Cells(1, 1).Value = 1
.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1, Trend:=False
End With
End If
End Sub
Sub Xoa_Sheet()
Application.DisplayAlerts = False
Dim ChuaSheets, sh, XoaSheets
ChuaSheets = Array("TRANG_CHU", "SK_THop", "", "")
For Each sh In Worksheets
XoaSheets = Filter(ChuaSheets, sh.Name, 1)
If UBound(XoaSheets) <> 0 Then
sh.Visible = True
sh.Delete
End If
Next
Application.DisplayAlerts = True
End Sub
Bạn nên sửa tiêu đề bài viết là "Giúp giải thích code Tách sheet và đánh lại số thứ tự cho từng sheet tách".
 
Web KT
Back
Top Bottom