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

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

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

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)