Skip to content

Instantly share code, notes, and snippets.

View FINDTEXTBOX
Option Explicit
Dim Cls As cSingleFind
Private Sub Worksheet_Activate()
Set Cls = New cSingleFind
With Sheet3
Cls.Main Sheet3, _ Code Name của trang tính cần hiện Textbox
"$B$2", _ Vị trí ô cần hiện Textbox
.TextBox1, _ Textbox tìm kiếm
.ListBox1, _ Listbox
Sheet2.Range("A2:C14").Value, _ Nguồn dữ liệu để ở dạng mảng
View ADO2VAR.BAS
Hàm Ado2Var lấy mảng từ câu lệnh ADO
Các hàm mảng tham khảo của Chip Pearson.
Hàm này dùng với addin Heo_ArrayFormular ngay trên bảng tính hoặc dùng trong VBA.
Nào mời các bạn test.
Function Ado2Var(StrSQL As String) As Variant
On Error GoTo ErrHander
Dim Cn As Object, Rs As Object
Set Cn = CreateObject("ADODB.Connection"): Set Rs = CreateObject("ADODB.Recordset")
View OnDoubleClick.bas
Option Explicit
Sub auto_open()
ThisWorkbook.Worksheets("Sheet1").OnDoubleClick = "Test"
End Sub
Sub Test()
If ActiveCell.Address = "$A$1" Then MsgBox "Hocexcel.Online"
End Sub
View BeforeDoubleClick.bas
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address = "$A$1" Then MsgBox "Hocexcel.online"
End Sub
View Exp2Pdf.bas
Option Explicit
Sub Exp2Pdf()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim cRng As Range, DATA As Variant, I As Long
Dim sPath As String, sName As String, sDate As Variant
DATA = Sheet1.Range("A2:I" & Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row).Value
On Error GoTo Errhander
For Each cRng In Sheet2.Range("G1:G" & Sheet2.Cells(Sheet2.Rows.Count, "G").End(xlUp).Row)
Sheet2.Range("E4").Value = cRng.Value
View ComboboxUf.bas
Option Explicit
Private DMHH As Variant
Private Sub CB_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Dim TMP As Variant
If KeyAscii = 32 Then
TMP = FindInArray(Trim(CB.Text), DMHH)
If Not IsEmpty(TMP) Then
CB.List = TMP
CB.DropDown
Else
View FindInArray.Bas
Option Explicit
Function FindInArray(fStr As Variant, sArr As Variant) As Variant
On Error GoTo thoat
If IsObject(fStr) Then
If fStr.Columns.Count = 1 And fStr.Rows.Count = 1 Then
fStr = fStr.Value2
Else
Exit Function
End If
End If
View AddDonGia.Bas
Sub AddDonGia()
Dim Dic As Object, Rng As Range, Data As Variant, MAHH As String, I As Long, J As Long
With ActiveCell
If .Column = 4 And .Count = 1 And .Offset(, -3).Value <> vbNullString Then
MAHH = CStr(.Offset(, -3).Value)
Data = Sheet1.Range("A2:D" & .Row - 1).Value
Set Dic = CreateObject("Scripting.dictionary")
For I = 1 To UBound(Data, 1)
If CStr(Data(I, 1)) = MAHH Then
If Data(I, 4) <> vbNullString Then
View Loc.bas
Sub Loc()
Dim DATA As Variant, I As Long, J As Long, TMP As Variant, MA As String, T As Double
DATA = Sheet1.Range("A2:C" & Sheet1.Cells(Sheet1.Rows.Count, "C").End(xlUp).Row).Value2
T = Timer
ReDim TMP(1 To 3, 1 To 1)
For I = 1 To UBound(DATA, 1)
MA = CStr(DATA(I, 1) & DATA(I, 2))
If MA <> vbNullString Then
J = J + 1
ReDim Preserve TMP(1 To 3, 1 To J)
View Loc.bas
Sub Loc()
Dim DATA As Variant, I As Long, J As Long, TMP As Variant, MA As String, T As Double
DATA = Sheet1.Range("A2:C" & Sheet1.Cells(Sheet1.Rows.Count, "C").End(xlUp).Row).Value2
T = Timer
ReDim TMP(0)
J = -1
For I = 1 To UBound(DATA, 1)
MA = CStr(DATA(I, 1) & DATA(I, 2))
If MA <> vbNullString Then
J = J + 1