'Code nay de xoa het cac sheet khong Can thiet. Ban co the su dung no cho nut bam xoa het cac sheet.
'Cac sheet: TIEUCHI, DATA, MAUTRINHBAY, SOLIEUTHO se khong bi xoa
Sub xoasheets()
Const tenshet As String = "TIEUCHI#DATA#MAUTRINHBAY#SOLIEUTHO"
Dim sh As Worksheet
Call Focus(True)
For Each sh In ThisWorkbook.Worksheets
If InStr(1, tenshet, sh.Name) = 0 Then
sh.Delete
End If
Next
Call Focus(False)
End Sub
'Muc dich:Tao ra cac sheet ket qua va ghi ket qua tinh toan vao
Sub taothemsheet_tuhocvba()
Dim arr As Variant, i As Long, lr As Long, dk As String, dks As String
Dim dic As Object, data As Variant, kq, sh As Worksheet, a As Long, b As Long, k As Integer
Dim j As Long
Dim rend As Long
Dim cend As Integer
Set dic = CreateObject("scripting.dictionary")
Call Focus(True) 'Tang toc VBA
ThisWorkbook.Sheets("TIEUCHI").Activate 'Lam viec voi sheet TIEUCHI
With Sheets("TIEUCHI")
rend = .Cells(Rows.Count, 2).End(xlUp).Row
arr = .Range(Cells(1, 1), Cells(rend, 2)).Value 'Lay du lieu cot A,B tren sheet TIEUCHI
End With
ThisWorkbook.Sheets("DATA").Activate 'Lam viec voi sheet DATA
With Sheets("DATA")
lr = .Range("D" & Rows.Count).End(xlUp).Row 'Lay dong cuoi cua sheet DATA
cend = .Cells(1, Columns.Count).End(xlToLeft).Column 'Cot cuoi tren sheet DATA
data = .Range(Cells(1, 4), Cells(lr, cend)).Value 'Lay du lieu D1:AC30000
For i = 2 To UBound(data, 1) 'Duyet qua tung dong cua sheet DATA-thuc te la mang data()
dk = data(i, 1) 'NAP CAC KEYWORD TREN COT D CUA SHEET DATA
dic.Item(dk) = i 'GHI LAI VI TRI DONG i VAO TU DIEN
Next i
For j = 2 To UBound(data, 2) 'Duyet qua tung cot cua sheet Data
dk = data(1, j) 'Ten cot. Ex: TONG DOANH THU HOAT DONG KINH DOANH
dic.Item(dk) = j 'Ghi lai vi tri cot vao tu dien
Next j
End With
'==============TINH TOAN KET QUA
For k = 1 To UBound(arr)
If kiemtrasheet(CStr(arr(k, 2))) = True Then
MsgBox "Hay xoa het cac sheet khong can thiet truoc khi chay chuong trinh"
Exit Sub
End If
ThisWorkbook.Sheets("MAUTRINHBAY").Activate
With Sheets("MAUTRINHBAY")
'Lay dong cuoi va cot cuoi tren sheet MAU TRINH BAY
rend = .Cells(Rows.Count, 1).End(xlUp).Row
cend = .Cells(1, Columns.Count).End(xlToLeft).Column
kq = .Range(Cells(1, 1), Cells(rend, cend)).Value 'A1:BP454
End With
Set sh = Worksheets.Add(After:=Worksheets(Worksheets.Count)) 'Them sheet moi vao phia ben phai
sh.Name = CStr(arr(k, 2)) 'Gan ten sheet theo cot B sheet TIEU CHI
b = dic.Item(arr(k, 1)) 'Tim xem arr(k, 1) =TONG DOANH THU HOAT DONG tren shet DATA la cot thu bao nhieu tinh tu cot D,
'tra ket qua vao b. b = 2.
If b Then 'Neu tim thay, tuc la b>0 thi thuc hien:
For i = 2 To UBound(kq)
For j = 2 To UBound(kq, 2)
dk = kq(i, 1) & " " & kq(1, j) 'Key word de tim kiem. Ex: AAV 2018
a = dic.Item(dk) 'Tim xem dong chua key word ay la dong nao tren sheet data. Ex = 14
If a Then
If data(a, b) Then kq(i, j) = data(a, b) 'lay ket qua sheet data o cot a dong b. Chu y vi tri cot tinh tu cot D.
Else
kq(i, j) = "0" 'Khong tim thay
End If
Next j
Next i
End If
sh.Range(Cells(1, 1), Cells(rend, cend)).Value = kq
Next k
Call Focus(False)
End Sub
'Thu tuc con duoc su dung de tang toc chuong trinh
Sub Focus(ByVal Flag As Boolean)
With Application
.EnableEvents = Not Flag
.ScreenUpdating = Not Flag
.DisplayAlerts = Not Flag
.Calculation = IIf(Flag, xlCalculationManual, xlCalculationAutomatic)
End With
End Sub
'Kiem tra ten sheet (Ex sheet name = tuhocvba) da ton tai trong workbook hay chua. Neu dang ton tai, ket qua tra ve la True
Function kiemtrasheet(ByVal tensheet As String) As Boolean
Dim n As Integer
Dim i As Integer
n = ThisWorkbook.Sheets.Count
For i = 1 To n Step 1
If ThisWorkbook.Sheets(i).Name = tensheet Then
kiemtrasheet = True
Exit Function
End If
Next i
kiemtrasheet = False 'mac dinh khong tim thay
End Function
