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
,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
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

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