Skip to content

Instantly share code, notes, and snippets.

View KiemTra.bas
Sub KiemTra()
Dim CheckMa As Integer
Dim SoDong As Long
CheckMa = Range("E4").Value
SoDong = Range("E5").Value
If CheckMa = 0 Then
MsgBox "Ma khong ton tai"
Exit Sub
View AnHien_Sheet.bas
Sub AnHien_Sheet()
Dim lr As Long
lr = Sheets("MENU").Cells(Rows.Count, 1).End(xlUp).Row
Dim sodong As Long
'An/hien sheet
For sodong = 2 To lr
'Mo an tat ca cac sheet
Worksheets(Sheets("MENU").Range("A" & sodong).Value).Visible = xlSheetVisible
'An sheet duoc danh dau
View SheetList.bas
Sub SheetList()
Dim ws As Worksheet
Dim lr As Long
lr = 2
For Each ws In ThisWorkbook.Worksheets
Sheets("MENU").Range("A" & lr).Value = ws.Name
lr = lr + 1
Next ws
End Sub
View BCTH_Export.Bas
Sub BCTH_Export() 'Bai tap xuat du lieu tu file nay sang file khac
'Thiet lap cac bien
Dim MyWB As Workbook, NewWB As Workbook
Set MyWB = ThisWorkbook
Set NewWB = Workbooks.Add
'Lay du lieu
NewWB.Worksheets("Sheet1").Range("A1:B17").PasteSpecial Paste:=xlPasteColumnWidths
NewWB.Worksheets("Sheet1").Range("A1:B17").PasteSpecial Paste:=xlPasteValues
NewWB.Worksheets("Sheet1").Range("A1:B17").PasteSpecial Paste:=xlPasteFormats
View Login_confirm.bas
Sub Login_confirm()
Dim username As String
Dim password As String
username = Sheets("Sheet1").Range("B3").Value 'Gán biến UserName tại vị trí người dùng nhập UserName là ô B3
password = Sheets("Sheet1").Range("B6").Value 'Gán biến Password tại vị trí người dùng nhập Password là ô B6
Dim i As Integer
i = 3 'Biến i đại diện cho dòng bắt đầu của danh sách tài khoản
If username = "" Or password = "" Then 'Xét trường hợp thiếu dữ kiện (không nhập 1 trong 2 ô)
View RebuildDefaultStyles.bas
Sub RebuildDefaultStyles()
'The purpose of this macro is to remove all styles in the active
'workbook and rebuild the default styles.
'It rebuilds the default styles by merging them from a new workbook.
'Dimension variables.
Dim MyBook As Workbook
Dim tempBook As Workbook
Dim CurStyle As Style
View DocSoThanhChu_Eng.bas
Function DocSoThanhChu_Eng(ByVal pNumber)
'Updateby20131113 - source:
Dim Dollars, Cents
arr = Array("", "", " Thousand ", " Million ", " Billion ", " Trillion ")
pNumber = Trim(Str(pNumber))
xDecimal = InStr(pNumber, ".")
If xDecimal > 0 Then
Cents = GetTens(Left(Mid(pNumber, xDecimal + 1) & "00", 2))
pNumber = Trim(Left(pNumber, xDecimal - 1))
End If
View DoCalcTimer.bas
Sub RangeTimer()
DoCalcTimer 1
End Sub
Sub SheetTimer()
DoCalcTimer 2
End Sub
Sub RecalcTimer()
DoCalcTimer 3
End Sub
Sub FullcalcTimer()
View MicroTimer.bas
Function MicroTimer() As Double 'Xac dinh thoi gian bang milisecond
' Returns seconds.
Dim cyTicks1 As Currency
Static cyFrequency As Currency
MicroTimer = 0
' Get frequency.
If cyFrequency = 0 Then getFrequency cyFrequency
' Get ticks.
getTickCount cyTicks1
' Seconds
View gist:1ecc73a81b89faa5830f0d4bdca7f43d
#1: Nếu dùng VBA phiên bản 7 thì copy đoạn code sau:
Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias _
"QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias _
"QueryPerformanceCounter" (cyTickCount As Currency) As Long
#2: Nếu dùng VBA các phiên bản khác thì copy đoạn code sau:
Private Declare Function getFrequency Lib "kernel32" Alias _
"QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare Function getTickCount Lib "kernel32" Alias _
"QueryPerformanceCounter" (cyTickCount As Currency) As Long