This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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) |
NewerOlder