Chuyên đề giải đáp những thắc mắc về code VBA

Liên hệ QC
maytinhvp01

maytinhvp01

Thành viên thường trực
Tham gia
27/7/13
Bài viết
390
Được thích
179
Mình muốn nhờ giải thich câu lệnh " If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c) "
trong ví du:
Public Function LonNhat(Ran As Range)
Dim max As Double, v As Integer, d As Integer, c As Integer
max = Ran.Cells(1, 1)
For d = 1 To Ran.Rows.Count
For c = 1 To Ran.Columns.Count
If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c)
Next c
Next d
v = Tim(max, Ran)
LonNhat = max
End Function
-------------------------------------------------------
[INFO1]Thông báo:
Vì topic này:
http://www.giaiphapexcel.com/forum/...ải-thích-các-code-đề-nghị-các-bạn-gửi-vào-đây
đã quá dài nên BQT đóng lại.
Nay tôi mở topic mới với cùng chủ đề: GIẢI THÍCH NHỮNG THẮC MẮC VỀ CODE
Các bạn nếu có nhu cầu giải thích code, vui lòng post tại đây nhé
NDU96081631
[/INFO1]
 
Chỉnh sửa lần cuối bởi điều hành viên:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
tueyennhi đã viết:
PHP: 
Option Explicit
Sub SendMail()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim i As Long
    Dim Addresslist As Object
    Application.ScreenUpdating = False
    Set Addresslist = CreateObject("Scripting.Dictionary")

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
  
    For Each cell In Columns("C").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And LCase(Cells(cell.Row, "F").Value) = "y" Then
                Set OutMail = OutApp.CreateItem(0)
                With OutMail
                    .Attachments.Add Cells(2, 5) & cell.Offset(0, 2) & ".xlsx"
                    .To = cell.Value
                    .Subject = Cells(cell.Row, "I").Value
                    .Body = Cells(cell.Row, "D").Value
                    .Send  'Or use Send us Display
                End With
                Set OutMail = Nothing
        End If
    Next cell

    Set OutApp = Nothing
    Set Addresslist = Nothing
    Application.ScreenUpdating = True
  
    MsgBox "Game over"
  
End Sub

Cho em hỏi làm thế nào để em chèn thêm chữ ký khi gửi mail hàng loạt (Tên chữ ký mặc định trong outlook em đặt là "Ky chung")
Nhấp chuột vào đây để mở rộng...
Bạn thêm 1 dòng
PHP: 
With OutMail
    .open
    ...
end with
 
Upvote 0
Ví dụ em có mảng với dữ liệu giờ như sau: 1/8/2019 8:00:39 PM
Vậy làm thế nào để chuyển đổi nó thành 1/8/2019 8:00:00 PM (chuyển số giây thành 0 hết) một cách đơn giản và tối ưu nhất?
 
Upvote 0
CDate(Format(duLieuNgayGio, "dd-mmm-yyyy hh:mm")) ' chặt bỏ phần giây phía sau
Application.Round(duLieuNgayGio * 1440, 0) / 1440 ' làm tròn đến số phút
 
Upvote 0
phong cách sql :)
Mã: 
DateAdd("n", DateDiff("n", 0, "1/8/2019 8:00:39 PM"), 0)
 
Upvote 0
VetMini đã viết:
CDate(Format(duLieuNgayGio, "dd-mmm-yyyy hh:mm")) ' chặt bỏ phần giây phía sau
Application.Round(duLieuNgayGio * 1440, 0) / 1440 ' làm tròn đến số phút
Nhấp chuột vào đây để mở rộng...
Cảm ơn anh! :)

Em thử nghiệm với một Range thì kết quả ra đúng ý em muốn. Nhưng khi lắp vào mảng nó không chạy.
Vao = CDate(Format(Arr(j, 3), "mmm/dd/yyyy hh:mm"))
Em phải viết lại như này thì chạy ngon lành
- Vao = Arr(j, 3)
- Vao = CDate(Format(Vao, "mmm/dd/yyyy hh:mm"))

Vì sao lại như vậy anh nhỉ?
Bài đã được tự động gộp:

AutoReply đã viết:
phong cách sql :)
Mã: 
DateAdd("n", DateDiff("n", 0, "1/8/2019 8:00:39 PM"), 0)
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn nhé!
 
Lần chỉnh sửa cuối:
Upvote 0
BÁC NÀO DỊCH DÙM EM NGUYÊN ĐOẠN CODE NÀY VỚI :


Mã: 
Sub fifo()
  Dim nhapArr(), xuatArr(), Res()
  Dim I As Long, n As Long, sRow As Long
  Dim sNhap As Double, sXuat As Double, dXuat As Date
  Dim Ma As String, tmp As String
  With Sheets("DATABB")
    I = .Range("A" & Rows.Count).End(xlUp).Row
    If I < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    nhapArr = .Range("A3:D" & I).Value
    I = .Range("F" & Rows.Count).End(xlUp).Row
    If I < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    xuatArr = .Range("F3:H" & I).Value
    sRow = UBound(xuatArr)
    ReDim Res(1 To sRow, 1 To 1)
  End With
  For I = 1 To sRow
    dXuat = xuatArr(I, 1): Ma = xuatArr(I, 2): sXuat = xuatArr(I, 3)
    tmp = ""
    If Len(Ma) > 0 And sXuat > 0 Then
      For n = 1 To UBound(nhapArr)
        If nhapArr(n, 1) > dXuat Then Exit For
        If nhapArr(n, 2) = Ma Then
          sNhap = nhapArr(n, 3)
          If sNhap > 0 Then
            If sNhap >= sXuat Then
              Res(I, 1) = tmp & nhapArr(n, 4)
              If Len(tmp) > 0 Then Res(I, 1) = Res(I, 1) & "(" & sXuat & ")"
              nhapArr(n, 3) = sNhap - sXuat
              sXuat = 0
              Exit For
            Else
              tmp = tmp & nhapArr(n, 4) & "(" & sNhap & "); "
              nhapArr(n, 3) = 0
              sXuat = sXuat - sNhap
            End If
          End If
        End If
      Next n
      If sXuat > 0 Then Res(I, 1) = tmp & "Thieu(" & sXuat & ")"
    End If
  Next I
  Sheets("DATABB").Range("I3").Resize(sRow) = Res
End Sub
 
Upvote 0
guitarnguyen1989 đã viết:
BÁC NÀO DỊCH DÙM EM NGUYÊN ĐOẠN CODE NÀY VỚI :


Mã: 
Sub fifo()
  Dim nhapArr(), xuatArr(), Res()
  Dim I As Long, n As Long, sRow As Long
  Dim sNhap As Double, sXuat As Double, dXuat As Date
  Dim Ma As String, tmp As String
  With Sheets("DATABB")
    I = .Range("A" & Rows.Count).End(xlUp).Row
    If I < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    nhapArr = .Range("A3:D" & I).Value
    I = .Range("F" & Rows.Count).End(xlUp).Row
    If I < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    xuatArr = .Range("F3:H" & I).Value
    sRow = UBound(xuatArr)
    ReDim Res(1 To sRow, 1 To 1)
  End With
  For I = 1 To sRow
    dXuat = xuatArr(I, 1): Ma = xuatArr(I, 2): sXuat = xuatArr(I, 3)
    tmp = ""
    If Len(Ma) > 0 And sXuat > 0 Then
      For n = 1 To UBound(nhapArr)
        If nhapArr(n, 1) > dXuat Then Exit For
        If nhapArr(n, 2) = Ma Then
          sNhap = nhapArr(n, 3)
          If sNhap > 0 Then
            If sNhap >= sXuat Then
              Res(I, 1) = tmp & nhapArr(n, 4)
              If Len(tmp) > 0 Then Res(I, 1) = Res(I, 1) & "(" & sXuat & ")"
              nhapArr(n, 3) = sNhap - sXuat
              sXuat = 0
              Exit For
            Else
              tmp = tmp & nhapArr(n, 4) & "(" & sNhap & "); "
              nhapArr(n, 3) = 0
              sXuat = sXuat - sNhap
            End If
          End If
        End If
      Next n
      If sXuat > 0 Then Res(I, 1) = tmp & "Thieu(" & sXuat & ")"
    End If
  Next I
  Sheets("DATABB").Range("I3").Resize(sRow) = Res
End Sub
Nhấp chuột vào đây để mở rộng...
Bạn muốn ghi chú sao không dùng phím F8.Chạy từng đoạn code.
 
Upvote 0
Chào mọi người.
Mọi người có thể giúp e code để xác định tên của User Form đang hiển thị được không ạ.
Ví dụ khi mình chuyển qua file khác thì ẩn form, và quay lại file đó thì hiện form lên.
Xin cám ơn !
 
Upvote 0
befaint đã viết:
Cuối cùng là mình muốn làm cái chi chi? Nói vậy hiểu răng được.
Nhấp chuột vào đây để mở rộng...
dễ hiểu mà. nghĩa là e tạo 1 userform sẽ hiển thị khi bật file đó lên.
và khi chuyển qua làm việc trên file khác thì userform đó sẽ tự động ẩn. và khi quay lại thì hiện lại form đó.
nữa là có code nào để xác định tên của user form đang load được không.? dạng như kiểu " activesheet.name " vậy á :d
 
Upvote 0
Sub Boimau()
Sheets("UU").Select
Range("N11:O38").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Sheets("YE").Select
Range("N11:O38").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Sheets("YG").Select
Range("N11:O38").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Sheets("YH").Select
Range("N11:O38").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Sheets("YJ").Select
Range("N11:O38").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Sheets("YN").Select
Range("N11:O38").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Sheets("YQ").Select
Range("N11:O38").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Sheets("YP").Select
Range("N11:O38").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Sheets("YR").Select
Range("N11:O38").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Sheets("YS").Select
Range("N11:O38").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Sheets("YT").Select
Range("N11:O38").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Sheets("QQ").Select
Range("N11:O38").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Sheets("NN").Select
Range("N11:O38").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Sheets("PP").Select
Range("N11:O38").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Sheets("VV").Select
Range("N11:O38").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Sheets("SS").Select
Range("N11:O38").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Sheets("TT").Select
Range("N11:O38").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Sheets("RR").Select
Range("N11:O38").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Sheets("QQ").Select
End Sub
Nhấp chuột vào đây để mở rộng...
Nhờ các thầy cô rút ngẵn đoạn code giúp em được không ạ
 
Upvote 0
buiquangthuan đã viết:
Nhờ các thầy cô rút ngẵn đoạn code giúp em được không ạ
Nhấp chuột vào đây để mở rộng...
Chạy thử xem sao
Mã: 
Sub Boimau_()
Dim Ten
Dim Ws As Worksheet
Dim IDic As Object
Dim t
Set IDic = CreateObject("Scripting.Dictionary")
Ten = Array("UU", "YE", "YG", "YH", "YJ", "YN", "YQ", "YP", "YR", "YS", "YT", "QQ", "NN", "PP", "VV", "SS", "TT", "RR", "QQ")
For Each t In Ten
    IDic.Item(t) = ""
Next t
For Each Ws In Worksheets
    If IDic.exists(Ws.Name) Then
        Ws.Range("N11:O38").Select
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
        End With
    End If
Next Ws
End Sub
 
Upvote 0
CHAOQUAY đã viết:
Chạy thử xem sao
Mã: 
Sub Boimau_()
Dim Ten
Dim Ws As Worksheet
Dim IDic As Object
Dim t
Set IDic = CreateObject("Scripting.Dictionary")
Ten = Array("UU", "YE", "YG", "YH", "YJ", "YN", "YQ", "YP", "YR", "YS", "YT", "QQ", "NN", "PP", "VV", "SS", "TT", "RR", "QQ")
For Each t In Ten
    IDic.Item(t) = ""
Next t
For Each Ws In Worksheets
    If IDic.exists(Ws.Name) Then
        Ws.Range("N11:O38").Select
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
        End With
    End If
Next Ws
End Sub
Nhấp chuột vào đây để mở rộng...
Nó báo lỗi thầy ơi
 

File đính kèm

  • anh1.png
    anh1.png
    178.7 KB · Đọc: 4
Upvote 0
PHP: 
Sub GPE(Rng As Range)
 With Rng.Interior
    .Pattern = xlSolid:                                 .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorLight2:     .TintAndShade = 0.799981688894314
    .PatternTintAndShade = 0
 End With
End Sub
Mã: 
Sub Boimau()
 Sheets("UU").Select
 Range("N11:O38").Select:           GPE Selection
 Sheets("YE").Select
 Range("N11:O38").Select:            GPE Selection
 Sheets("YG").Select
 Range("N11:O38").Select:            GPE Selection
 Sheets("YH").Select
 Range("N11:O38").Select:            GPE Selection
 Sheets("YJ").Select
 Range("N11:O38").Select:            GPE Selection
 Sheets("YN").Select
 Range("N11:O38").Select:            GPE Selection
 Sheets("YQ").Select
 Range("N11:O38").Select:            GPE Selection
 Sheets("YP").Select
 Range("N11:O38").Select:            GPE Selection
 Sheets("YR").Select
 Range("N11:O38").Select:            GPE Selection
 Sheets("YS").Select
 Range("N11:O38").Select:            GPE Selection
 Sheets("YT").Select
 Range("N11:O38").Select:            GPE Selection
 Sheets("QQ").Select
 Range("N11:O38").Select:            GPE Selection
 Sheets("NN").Select
 Range("N11:O38").Select:            GPE Selection
 Sheets("PP").Select
 Range("N11:O38").Select:            GPE Selection
 Sheets("VV").Select
 Range("N11:O38").Select:            GPE Selection
 Sheets("SS").Select
 Range("N11:O38").Select:            GPE Selection
 Sheets("TT").Select
 Range("N11:O38").Select:            GPE Selection
 Sheets("RR").Select
 Range("N11:O38").Select:            GPE Selection
 Sheets("QQ").Select
 End Sub
 
Upvote 0
SA_DQ đã viết:
PHP: 
Sub GPE(Rng As Range)
With Rng.Interior
    .Pattern = xlSolid:                                 .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorLight2:     .TintAndShade = 0.799981688894314
    .PatternTintAndShade = 0
End With
End Sub
Mã: 
Sub Boimau()
Sheets("UU").Select
Range("N11:O38").Select:           GPE Selection
Sheets("YE").Select
Range("N11:O38").Select:            GPE Selection
Sheets("YG").Select
Range("N11:O38").Select:            GPE Selection
Sheets("YH").Select
Range("N11:O38").Select:            GPE Selection
Sheets("YJ").Select
Range("N11:O38").Select:            GPE Selection
Sheets("YN").Select
Range("N11:O38").Select:            GPE Selection
Sheets("YQ").Select
Range("N11:O38").Select:            GPE Selection
Sheets("YP").Select
Range("N11:O38").Select:            GPE Selection
Sheets("YR").Select
Range("N11:O38").Select:            GPE Selection
Sheets("YS").Select
Range("N11:O38").Select:            GPE Selection
Sheets("YT").Select
Range("N11:O38").Select:            GPE Selection
Sheets("QQ").Select
Range("N11:O38").Select:            GPE Selection
Sheets("NN").Select
Range("N11:O38").Select:            GPE Selection
Sheets("PP").Select
Range("N11:O38").Select:            GPE Selection
Sheets("VV").Select
Range("N11:O38").Select:            GPE Selection
Sheets("SS").Select
Range("N11:O38").Select:            GPE Selection
Sheets("TT").Select
Range("N11:O38").Select:            GPE Selection
Sheets("RR").Select
Range("N11:O38").Select:            GPE Selection
Sheets("QQ").Select
End Sub
Nhấp chuột vào đây để mở rộng...
Nó chạy lâu quá thầy ơi. Hay máy em cùi mía nhỉ
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

L
Xin được cách hướng dẫn toán lớp 2
Trả lời
11
Đọc
123
anhtuanle123
A
tonny jj
Lập hàm thể hiện số công lệnh của ngày đi công tác
Trả lời
0
Đọc
3
tonny jj
tonny jj
L
Viết phần mềm đánh lô bằng Visual Basic
    • Thích
2 3
Trả lời
56
Đọc
103K
anhtuanle123
A
vc_đi chơi
Lỗi "####" trong ô khi in
    • Thích
Trả lời
1
Đọc
29
HUONGHCKT
H
A
Kính nhờ xử lý nhập công thức hàm IF kết hợp nhiều điều kiện
Trả lời
2
Đọc
43
tieutuvodanh192
tieutuvodanh192
K
  • Question Question
BÀI TOÁN TÌM GIÁ USD VÀ TÌM LƯỢNG KG - NHỜ ANH/CHỊ GIÚP ĐỠ
    • Chấp nhận
Trả lời
14
Đọc
177
CHAOQUAY
C
nghiahandsome1995
  • Question Question
in đậm chuỗi văn bản bằng excel
Trả lời
2
Đọc
46
HUONGHCKT
H
TKT
In đậm trong công thức ghép chuỗi
2
Trả lời
28
Đọc
51K
nghiahandsome1995
nghiahandsome1995
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
14 15 16
Trả lời
316
Đọc
23K
kunkoi9390
K
S
Lỗi Path/File access error:'.\VBFB.tmp'
Trả lời
11
Đọc
4K
HeSanbi
HeSanbi
G
Dấu = trong excel bị đảo ngược từ trước ra sau
Trả lời
3
Đọc
33
vanle33
vanle33
T
Lỗi ngắt chữ khi xuống dòng
Trả lời
1
Đọc
23
HeSanbi
HeSanbi
Mewwo98
Cách chạy Add-in khi khởi động excel
Trả lời
7
Đọc
93
tigertiger
tigertiger
N
Thử viết code lập trình đa luồng bằng TwinBasic và khả năng ứng dụng vào COM add-in chạy trong Excel
    • Thích
Trả lời
3
Đọc
312
nguyendang95
N
K
Mở file Excell lên bị lỗi run-time error 76' path not found
Trả lời
0
Đọc
27
kunkoi9390
K
tuankieu28
Hướng dẫn hàm tìm thông tin
Trả lời
0
Đọc
30
tuankieu28
tuankieu28
Momominh
Hỏi công thức tìm kiếm
Trả lời
2
Đọc
47
thuytrangbp28
T
huongmuine
Điền số thứ tự theo nhóm có điều kiện
Trả lời
4
Đọc
66
huongmuine
huongmuine
Mewwo98
Thay dấu ngăn cách sau chữ số hàng nghìn, hàng triệu, hàng tỷ trong Mail Merge
Trả lời
12
Đọc
245
HeSanbi
HeSanbi
H
Nhờ các bạn mở quá công thức của các sheet
Trả lời
3
Đọc
71
VetMini
V
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới Ất Tỵ 2025
Back
Top Bottom