TGDUY

Function SoSanh(ListA As Range, ListB As Range, Cr As Byte) As Variant
Dim Dic As Object, TmpA As Variant, TmpB As Variant, I As Long, J As Long, Tmp As Variant
Set Dic = CreateObject("Scripting.Dictionary")
TmpA = ListA.Value2: TmpB = ListB.Value2: ReDim Tmp(0)
J = -1
For I = LBound(TmpA, 1) To UBound(TmpA, 1)
    If Not Dic.exists(CStr(TmpA(I, 1))) Then Dic.Add CStr(TmpA(I, 1)), CStr(TmpA(I, 1))
Next

For I = LBound(TmpB, 1) To UBound(TmpB, 1)

TGDUY

Sub Resize2Darr()
Dim InputArr As Variant, ColExport As Variant, ColVar As Variant, I As Long 'Khai báo Mảng nguồn, mảng chứa các cột xuất ra, mảng chứa các hàng cần xuất ra
InputArr = Sheet1.Range("A1:G" & Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row).Value 'Lấy mảng nguồn từ bảng tính
ColExport = [{1,3,5,7,6,2}]'Các cột xuất ra theo số thứ tự chúng ta mong muốn 
ReDim ColVar(1 To UBound(InputArr, 1), 1 To 1) ' Chỉnh kích thước cho mảng chứa các hàng cần xuất ra , ở đây là toàn bộ số hàng của mảng nguồn
For I = LBound(InputArr, 1) To UBound(InputArr, 1)'cho vòng lặp chạy từ phần tử đầu tiên tới phần tử cuối cùng của mảng nguồn
ColVar(I, 1) = I 'ghi số hàng vào mảng chứa các các hàng cần xuất
Next
    Sheet1.Range("K1").Resize(UBound(InputArr, 1), UBound(ColExport, 1)) = Application.Index(InputArr, ColVar, ColExport)' Đưa dữ liệu vào sheet tính từ ô K1
End Sub

TGDUY

Option Explicit
Sub NewPhieuNX(MaPhieu)
Dim cSoChungTu As Range, fRng As Range, Endrow As Long
  Endrow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row 'Xác định dòng cuối cùng cột A
Set cSoChungTu = Sheet1.Range("A2:A" & Endrow) 'Xác định phạm vi tìm khiến
Set fRng = cSoChungTu.Find(MaPhieu, , xlValues, xlPart, , xlPrevious, True)'Thiết lập kiểu tìm kiếm
  If Not fRng Is Nothing Then '' Nếu tìm thấy phiếu gần nhất
    Sheet1.Range("A" & Endrow + 1).Value = MaPhieu & Format(Right(CStr(fRng.Value), 4) + 1, "0000")' Tạo phiếu mới bằng các nối mã phiếu và số phiếu gần nhất tịnh tiến thêm 1 đơn vị
    Set fRng = Nothing' Giải phóng biến
    Else ' Nếu không tìm thấy phiếu gần nhất, tức trong dữ liệu chưa tồn tại loại phiếu này

TGDUY

Sub TrangHoang()
Dim Dic As Object, KQ As Range
Dim TmpVao As Variant, TmpRa As Variant, Tmp As Variant, I As Long, J As Long
  Set Dic = CreateObject("Scripting.Dictionary") 'Khởi tạo dictionary
With Sheet1
TmpRa = .Range("A3:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value 'Dữ liệu sẵn có ở cột A
TmpVao = .Range("G3:G" & .Cells(.Rows.Count, "G").End(xlUp).Row).Value ' Dữ liệu ở Cột G
Set KQ = .Range("A" & .Cells(.Rows.Count, "A").End(xlUp).Row).Offset(1)' Ô cần gắn kết quả
End With
For I = LBound(TmpRa, 1) To UBound(TmpRa, 1)' Vòng lặp chạy qua cột A

TGDUY

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then' Tác động đến ô A1
   If Target.Value = vbNullString Then 'Nếu ô A1 rỗng
      Range("B1").Font.Bold = False 'Thì ô B1 định dạng bình thường
   Else ' Nếu A1 không rỗng
      Range("B1").Font.Bold = True '' Thì tô đậm ô B1
   End If
End If
End Sub

TGDUY

Sub MinhDang()
Dim StartDate As Date, TMP() As Date, Totalday As Long, I As Long
With Sheet1
  StartDate = CDate(.Range("A1").Value)'Ngày bắt đầu tính từ ô A1
  Totalday = CLng(.Range("B1").Value)' Số ngày cần điền
  .Range("C1:C1048576").ClearContents 'Xóa dữ liệu cột C
  For I = 1 To Totalday ' Vòng lăọ chạy từ 1 tới tổng số ngày
  .Range("C" & I) = StartDate + I - 1 '' Điền dữ liệu vào cột C
     Next
End With

TGDUY

Sub AddImage()
Dim myFile As FileDialog, ImgFile, myImg As Variant, ZoomF As String
On Error Resume Next

Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
  .Title = "Choose File"
  .AllowMultiSelect = False 
  .Filters.Add Description:="Images", Extensions:="*.jpg,*.Jpg,*.gif,*.png,*.tif,*.bmp", Position:=1 
  If .Show <> -1 Then 

TGDUY

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

TGDUY

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)

TGDUY

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