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

maytinhvp01 · 31/7/13

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]

Hoàng Nhật Phương · 31/12/18

Con cảm ơn bác Siwtom về những chỉ dẫn rất chi tiết ạ.
Vấn đề tìm kiếm với ô ghép con cũng đã xử lý được ngay tức thời rồi ạ,trước khi tìm thì hủy merge là được. Có chút cảm hứng nên con tìm hiểu để biết thêm về cách viết hàm và lấy giá trị của hàm ạ.
Con chúc bác sức khỏe.
Oanh Thơ.

batman1 · 31/12/18

Nguyễn Hoàng Oanh Thơ đã viết:
Con cảm ơn bác Siwtom về những chỉ dẫn rất chi tiết ạ.
Vấn đề tìm kiếm với ô ghép con cũng đã xử lý được ngay tức thời rồi ạ,trước khi tìm thì hủy merge là được. Có chút cảm hứng nên con tìm hiểu để biết thêm về cách viết hàm và lấy giá trị của hàm ạ.
Con chúc bác sức khỏe.
Oanh Thơ.

Thì tôi cũng chỉ muốn lưu ý là không cần hủy merge.
Nếu tôi viết

Mã:

Set rng = ThisWorkbook.Worksheets("DL").Range("I1:I" & Rows.Count).Find(Target.Value, , xlValues, xlWhole, xlByColumns, xlNext)

mà FIND không tìm thấy, tức rng là Nothing, thì không bắt buộc phải hủy merge mà chỉ cần sửa thành Rows.Count-1 hoặc thay Rows.Count bằng lastRow, với lastRow được xác định bằng End(xlUp). Tôi chỉ muốn nhấn mạnh là có lúc tôi tưởng phải bỏ merge nhưng thực ra tôi lầm.

Còn về cái bạn hỏi trong chủ đề này thì đơn giản thôi. Hàm của bạn trả về 1 đối tượng, ở đây là đối tượng Range. Với đối tượng thì bạn phải dùng từ khóa SET

Mã:

Set txtAddress = MyFind("NguyenHoangOanhTho", rngtxt)

Tất nhiên txtAddress là cái tên không đúng vì nó là đối tượng Range chứ không phải giá trị String (address)

Hoàng Nhật Phương · 31/12/18

batman1 đã viết:
Thì tôi cũng chỉ muốn lưu ý là không cần hủy merge.
Nếu tôi viết

Mã:

Set rng = ThisWorkbook.Worksheets("DL").Range("I1:I" & Rows.Count).Find(Target.Value, , xlValues, xlWhole, xlByColumns, xlNext)

mà FIND không tìm thấy, tức rng là Nothing, thì không bắt buộc phải hủy merge mà chỉ cần sửa thành Rows.Count-1 hoặc thay Rows.Count bằng lastRow, với lastRow được xác định bằng End(xlUp). Tôi chỉ muốn nhấn mạnh là có lúc tôi tưởng phải bỏ merge nhưng thực ra tôi lầm.

Còn về cái bạn hỏi trong chủ đề này thì đơn giản thôi. Hàm của bạn trả về 1 đối tượng, ở đây là đối tượng Range. Với đối tượng thì bạn phải dùng từ khóa SET

Mã:

Set txtAddress = MyFind("NguyenHoangOanhTho", rngtxt)

Tất nhiên txtAddress là cái tên không đúng vì nó là đối tượng Range chứ không phải giá trị String (address)

Dạ vâng,con hiểu rồi.Con cảm ơn bác nhiều ạ.

tueyennhi · 5/1/19

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

snow25 · 5/1/19

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

Bạn xóa cái code body đi.
Hoặc là bạn tạo chữ ký trong cells rồi gọi vào.

tueyennhi · 5/1/19

snow25 đã viết:
Bạn xóa cái code body đi.
Hoặc là bạn tạo chữ ký trong cells rồi gọi vào.

Mình xóa body đi cũng không có bạn ạ. Cách thứ 2 mình sẽ làm sau khi không còn cách nào khác

(

vanthinh3101 · 5/1/19

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

Bạn thêm 1 dòng

PHP:

With OutMail
    .open
    ...
end with

tam888 · 5/1/19

tueyennhi đã viết:
Mình xóa body đi cũng không có bạn ạ. Cách thứ 2 mình sẽ làm sau khi không còn cách nào khác (

VBA mail đó ở đâu, Excel hay Outlook, nếu ở Outlook thì luôn lấy được
Tiếc tôi không có outlook để thử (test)

tueyennhi · 5/1/19

tam888 đã viết:
VBA mail đó ở đâu, Excel hay Outlook, nếu ở Outlook thì luôn lấy được
Tiếc tôi không có outlook để thử (test)

Ở Excel bạn ạ.

BuiQuangThuan · 7/1/19

tueyennhi · 16/1/19

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?

VetMini · 16/1/19

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

AutoReply · 17/1/19

phong cách sql

Mã:

DateAdd("n", DateDiff("n", 0, "1/8/2019 8:00:39 PM"), 0)

tueyennhi · 17/1/19

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

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: 17/1/19

AutoReply đã viết:
phong cách sql

Mã:

DateAdd("n", DateDiff("n", 0, "1/8/2019 8:00:39 PM"), 0)

Cảm ơn bạn nhé!

guitarnguyen1989 · 17/1/19

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

VetMini · 17/1/19

guitarnguyen1989 đã viết:
BÁC NÀO DỊCH DÙM EM NGUYÊN ĐOẠN CODE NÀY VỚI :

Mã:

Sub fifo() ... End Sub

Dịch (vị trí): từ đâu sang đâu?
Dịch (ngôn ngữ): từ VBA sang ngôn ngữ nào?

snow25 · 17/1/19

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

Bạn muốn ghi chú sao không dùng phím F8.Chạy từng đoạn code.

A Đặng · 18/1/19

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 !

befaint · 19/1/19

A Đặng đã viết:
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.

Cuối cùng là mình muốn làm cái chi chi? Nói vậy hiểu răng được.

A Đặng · 19/1/19

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.

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

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

Thành viên thường trực

Thành viên gắn bó

Thành viên gạo cội

Thành viên gắn bó

Thành viên tích cực

Thành viên gạo cội

Thành viên tích cực

Thành viên tích cực

Thành viên tích cực

Thành viên tích cực

❆❆❆❆❆❆❆❆❆❆❆❆

Thành viên tích cực

Ăn cùng góc phố

Thành viên tiêu biểu

Thành viên tích cực

Thành viên chính thức

Ăn cùng góc phố

Thành viên gạo cội

Thành viên mới

|||||||||||||

Thành viên mới

Facebook

Group