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 · 16/10/18

Nhờ các bạn giúp đỡ Oanh Thơ trường hợp sau với ạ,với code sau:

Mã:

Sub MySub(ColSum1 As Integer, Optional ColSum2 As Integer = 0, Optional ColSum3 As Integer = 0)
     Dim arr()
     arr = Range("C3:F11").Value
     Range("K3").Resize(9, 1) = arr(1, ColSum1) + arr(1, ColSum2) + arr(1, ColSum3)
End Sub

Sub testMySub()
    Call MySub(1, 2)
End Sub

Khi Oanh Thơ chạy testMySub,
code báo lỗi: Subscript out of range (Error 9) tại dòng: Range("K3").Resize(9, 1) = arr(1, ColSum1) + arr(1, ColSum2) + arr(1, ColSum3)
Nguyên nhân do: MySub(1, 2) truyền vào thiếu 1 tham số.

Vậy để khắc phục lỗi này thì trong MySub phải đặt câu lệnh khắc phục lỗi như thê nào để khi chạy testMySub code vẫn hoạt động bình thường
khi Call MySub truyền đủ hoặc không đủ tham số?

HieuCD · 16/10/18

Nguyễn Hoàng Oanh Thơ đã viết:
Nhờ các bạn giúp đỡ Oanh Thơ trường hợp sau với ạ,với code sau:

Mã:

Sub MySub(ColSum1 As Integer, Optional ColSum2 As Integer = 0, Optional ColSum3 As Integer = 0) Dim arr() arr = Range("C3:F11").Value Range("K3").Resize(9, 1) = arr(1, ColSum1) + arr(1, ColSum2) + arr(1, ColSum3) End Sub Sub testMySub() Call MySub(1, 2) End Sub

Khi Oanh Thơ chạy testMySub,
code báo lỗi: Subscript out of range (Error 9) tại dòng: Range("K3").Resize(9, 1) = arr(1, ColSum1) + arr(1, ColSum2) + arr(1, ColSum3)
Nguyên nhân do: MySub(1, 2) truyền vào thiếu 1 tham số.

Vậy để khắc phục lỗi này thì trong MySub phải đặt câu lệnh khắc phục lỗi như thê nào để khi chạy testMySub code vẫn hoạt động bình thường
khi Call MySub truyền đủ hoặc không đủ tham số?

Dùng hàm IIF(ColSum2=0,0,arr(1, ColSum2)) gọn nhưng nghe nói chạy chậm, có thể vẫn còn lỗi

befaint · 16/10/18

#1549:
. Giả sử đơn giản bẫy lỗi khi chỉ số cột <1 thì trả về giá trị =0.

PHP:

Dim heso as Long
If colSum <1 then
 heso =0 
 colSum =1 
Else 
heso =1
End if
Ketqua= heso*arr(1,colSum)

VetMini · 16/10/18

HieuCD đã viết:
Dùng hàm IIF(ColSum2=0,0,arr(1, ColSum2)) gọn nhưng nghe nói chạy chậm, có thể vẫn còn lỗi

Chậm: phải trên chục ngàn lượt chạy mới có khác biệt.
Lỗi: IIF là một hàm. Khi gọi hàm thì VBA phải tính tất cả các tham để nạp vào. Tức là biểu thức arr(1, ColSum2) không thoát.
Chạy thử sub t sau đây thì biết
Function f1()
f1 = 1
MsgBox "f1 called"
End Function
Function f2()
f2 = 2
MsgBox "f2 called"
End Function
Sub t()
MsgBox "ket qua la " & IIf(1 > 0, f1, f2)
End Sub

HieuCD · 16/10/18

VetMini đã viết:
Chậm: phải trên chục ngàn lượt chạy mới có khác biệt.
Lỗi: IIF là một hàm. Khi gọi hàm thì VBA phải tính tất cả các tham để nạp vào. Tức là biểu thức arr(1, ColSum2) không thoát.
Chạy thử sub t sau đây thì biết
Function f1()
f1 = 1
MsgBox "f1 called"
End Function
Function f2()
f2 = 2
MsgBox "f2 called"
End Function
Sub t()
MsgBox "ket qua la " & IIf(1 > 0, f1, f2)
End Sub

Các bài trước bạn đã lưu ý rồi, nhưng không nhớ hết

cảm thấy không yên tâm nên mới thòng thêm câu "có thể còn lỗi"

Hoàng Nhật Phương · 16/10/18

Xin cảm ơn các bạn HieuCD,befaint,VetMini đã giúp đỡ.

LamTran0202 · 17/10/18

Help me....! mình có 1 file xecell gồm 2 sheet (data và packing) bên sheet data mình có cột A là tên chi tiết mình muốn dùng 1 đoạn code bằng VBA tự đông copy dữ liệu ở cột A sheet "data" sang cột B sheet "packing" - ở cột A sheet data có một vài ô không có dư liệu thì không copy. nếu dùng autofillter rồi copy/past vẫn đc nhừng mình muốn ứng dung VBA để học hỏi, có ai giúp mình đoạn code.

♫ђöล♥ßล†♥†µ♫ · 17/10/18

LamTran0202 đã viết:
Help me....! mình có 1 file xecell gồm 2 sheet (data và packing) bên sheet data mình có cột A là tên chi tiết mình muốn dùng 1 đoạn code bằng VBA tự đông copy dữ liệu ở cột A sheet "data" sang cột B sheet "packing" - ở cột A sheet data có một vài ô không có dư liệu thì không copy. nếu dùng autofillter rồi copy/past vẫn đc nhừng mình muốn ứng dung VBA để học hỏi, có ai giúp mình đoạn code.

Hiếp tôi. Hiếp tôi ...
Đây là Topic "Giải đáp những thắc mắc vè Code VBA" mờ

LamTran0202 · 17/10/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Hiếp tôi. Hiếp tôi ...
Đây là Topic "Giải đáp những thắc mắc vè Code VBA" mờ

Thế phải đăng bài ở chổ mô, i don't know, ple hiep me

VetMini · 17/10/18

LamTran0202 đã viết:
Thế phải đăng bài ở chổ mô, i don't know, ple hiep me

Figure it out for yourself.
At least, show that you can take initiative to learn rather than waiting to get spoonfed.

be_09 · 18/10/18

LamTran0202 đã viết:
Thế phải đăng bài ở chổ mô, i don't know, ple hiep me

Muốn biết chỗ nào thì đọc lại nội quy tại khoản 1, mục II. Hình thức của bài viết (sẽ hiểu rõ hơn):
https://www.giaiphapexcel.com/diendan/help/terms/

aduy89 · 18/10/18

Mã:

Sub tao_ngau_nhien()
   Dim arr_1(9), arr_2(9) As Long
   Dim i As Long
  
  
    
   Dim hm As WorksheetFunction
   Set hm = Application.WorksheetFunction
   For i = LBound(arr_2) To UBound(arr_2)
      arr_1(i) = Rnd
      'arr_2(i) = hm.Rank(arr_1(i), ...............
      Debug.Print arr_1(i), arr_2(i)
      
   Next i

End Sub

Em mới học em đang bế tắc ở bước viết code cho hàm RANK. Mong thầy, cô các bạn chỉ bảo

Lequocvan · 18/10/18

Em chưa nghĩ ra cách chỉnh code để đếm số lượng (số lần xuất hiện) của cột TKTG theo điều kiện như trong file. Mong các Sư phụ chỉ giúp!

Mã:

Sub test1()
    Worksheets("Sheet2").Select
    Dim dic As Object
    Dim iRow As Long, i As Long
    Dim Arr() As Variant, VungDuLieu As Variant

    Dim k As Variant
    
    With Sheets("Sheet2")
        Set dic = CreateObject("Scripting.Dictionary")
        Set Dic2 = CreateObject("Scripting.Dictionary")
        VungDuLieu = Range("A1", Range("A1").End(xlToRight).End(xlDown).Address).Value '65536 '1048576
        ReDim Arr(1 To UBound(VungDuLieu, 1), 1 To 29)
        
        VungDuLieu2 = Range("O2:O40").Value
        
        For iRow = 1 To UBound(VungDuLieu, 1)
            If Not IsEmpty(VungDuLieu(iRow, 5)) And Not dic.Exists(VungDuLieu(iRow, 5)) Then
                i = i + 1
                dic.Add VungDuLieu(iRow, 5), i
                Arr(i, 1) = VungDuLieu(iRow, 5)
                
                'MsgBox "Tai: " & iRow & "___" & VungDuLieu(iRow, 7)
            Else
                
            End If
            
        Next iRow
        
        
        
    End With
    
    'MsgBox dic.count
    
    Sheets("Sheet2").Select
    With Sheets("Sheet2")
        .Range("O2").Resize(i, 3).Value = Arr
    End With
    Set dic = Nothing
End Sub

♫ђöล♥ßล†♥†µ♫ · 18/10/18

Lequocvan đã viết:

Em chưa nghĩ ra cách chỉnh code để đếm số lượng (số lần xuất hiện) của cột TKTG theo điều kiện như trong file. Mong các Sư phụ chỉ giúp!

Mã:

Sub test1()
    Worksheets("Sheet2").Select
    Dim dic As Object
    Dim iRow As Long, i As Long
    Dim Arr() As Variant, VungDuLieu As Variant

    Dim k As Variant
  
    With Sheets("Sheet2")
        Set dic = CreateObject("Scripting.Dictionary")
        Set Dic2 = CreateObject("Scripting.Dictionary")
        VungDuLieu = Range("A1", Range("A1").End(xlToRight).End(xlDown).Address).Value '65536 '1048576
        ReDim Arr(1 To UBound(VungDuLieu, 1), 1 To 29)
      
        VungDuLieu2 = Range("O2:O40").Value
      
        For iRow = 1 To UBound(VungDuLieu, 1)
            If Not IsEmpty(VungDuLieu(iRow, 5)) And Not dic.Exists(VungDuLieu(iRow, 5)) Then
                i = i + 1
                dic.Add VungDuLieu(iRow, 5), i
                Arr(i, 1) = VungDuLieu(iRow, 5)
              
                'MsgBox "Tai: " & iRow & "___" & VungDuLieu(iRow, 7)
            Else
              
            End If
          
        Next iRow
      
      
      
    End With
  
    'MsgBox dic.count
  
    Sheets("Sheet2").Select
    With Sheets("Sheet2")
        .Range("O2").Resize(i, 3).Value = Arr
    End With
    Set dic = Nothing
End Sub

Bạn thử như vầy xem

PHP:

Sub test1()
    Dim Dic As Object
    Dim sArr, dArr, I As Long, K As Long
With Sheets("Sheet2")
    Set Dic = CreateObject("Scripting.Dictionary")
    sArr = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Resize(, 10).Value
    ReDim dArr(1 To UBound(sArr), 1 To 3)
    For I = 1 To UBound(sArr)
        If Not Dic.Exists(sArr(I, 5)) Then
            K = K + 1
            Dic.Add sArr(I, 5), K
            dArr(K, 1) = sArr(I, 5)
            If sArr(I, 2) = "HoiSo" Then
                If sArr(I, 10) = "USD" Then dArr(K, 2) = 1 Else dArr(K, 3) = 1
            End If
        Else
            If sArr(I, 2) = "HoiSo" Then
                If sArr(I, 10) = "USD" Then dArr(Dic.Item(sArr(I, 5)), 2) = dArr(Dic.Item(sArr(I, 5)), 2) + 1 Else _
                        dArr(Dic.Item(sArr(I, 5)), 3) = dArr(Dic.Item(sArr(I, 5)), 3) + 1
            End If
        End If
    Next I
End With
With Sheets("Sheet2")
    If K Then .Range("O3").Resize(K, 3).Value = dArr
End With
Set Dic = Nothing
End Sub

phulien1902 · 18/10/18

♫ђöล♥ßล†♥†µ♫ đã viết:

Bạn thử như vầy xem

PHP:

Sub test1()
    Dim Dic As Object
    Dim sArr, dArr, I As Long, K As Long
With Sheets("Sheet2")
    Set Dic = CreateObject("Scripting.Dictionary")
    sArr = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Resize(, 10).Value
    ReDim dArr(1 To UBound(sArr), 1 To 3)
    For I = 1 To UBound(sArr)
        If Not Dic.Exists(sArr(I, 5)) Then
            K = K + 1
            Dic.Add sArr(I, 5), K
            dArr(K, 1) = sArr(I, 5)
            If sArr(I, 2) = "HoiSo" Then
                If sArr(I, 10) = "USD" Then dArr(K, 2) = 1 Else dArr(K, 3) = 1
            End If
        Else
            If sArr(I, 2) = "HoiSo" Then
                If sArr(I, 10) = "USD" Then dArr(Dic.Item(sArr(I, 5)), 2) = dArr(Dic.Item(sArr(I, 5)), 2) + 1 Else _
                        dArr(Dic.Item(sArr(I, 5)), 3) = dArr(Dic.Item(sArr(I, 5)), 3) + 1
            End If
        End If
    Next I
End With
With Sheets("Sheet2")
    If K Then .Range("O3").Resize(K, 3).Value = dArr
End With
Set Dic = Nothing
End Sub

File bài này đâu cho anh xem với nhỉ?

♫ђöล♥ßล†♥†µ♫ · 18/10/18

phulien1902 đã viết:
File bài này đâu cho anh xem với nhỉ?

Em dạo này chăm chỉ đột xuất Anh ạ. Mò sang tận đây để lấy bài ạ

HieuCD · 18/10/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Em dạo này chăm chỉ đột xuất Anh ạ. Mò sang tận đây để lấy bài ạ

Chắc phải ra chợ Kim Biên mua mấy ổ khóa, tối về khóa "máy tính" lại cho yên tâm

"If sArr(I, 2) = "HoiSo" Then" dùng 2 lần thấy sao sao ấy, dùng 1 lần được không

♫ђöล♥ßล†♥†µ♫ · 18/10/18

HieuCD đã viết:
Chắc phải ra chợ Kim Biên mua mấy ổ khóa, tối về khóa "máy tính" lại cho yên tâm
"If sArr(I, 2) = "HoiSo" Then" dùng 2 lần thấy sao sao ấy, dùng 1 lần được không

Lúc đầu em cũng đưa ra ngoài Dic nhưng nhà họ yêu cầu đếm duy nhất và tổng hợp số lượng với cái "HoiSo" nên lại đưa vào trong Anh ạ. Hay Anh viết lại cho em học với

HieuCD · 18/10/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Lúc đầu em cũng đưa ra ngoài Dic nhưng nhà họ yêu cầu đếm duy nhất và tổng hợp số lượng với cái "HoiSo" nên lại đưa vào trong Anh ạ. Hay Anh viết lại cho em học với

Đưa ra ngoài cho gọn

Mã:

Sub test1()
    Dim Dic As Object, ikey
    Dim sArr, dArr, i As Long, k As Long, ik As Long
    
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet2")
    sArr = .Range("A2:J2", .Range("A" & Rows.Count).End(xlUp)).Value
End With
    ReDim dArr(1 To UBound(sArr), 1 To 3)
    For i = 1 To UBound(sArr)
        ikey = sArr(i, 5)
        If Not Dic.Exists(ikey) Then
            k = k + 1
            Dic.Add ikey, k
            dArr(k, 1) = ikey
        End If
        If sArr(i, 2) = "HoiSo" Then
          ik = Dic.Item(ikey)
          If ik > 0 Then
            If sArr(i, 10) = "USD" Then
              dArr(ik, 2) = dArr(ik, 2) + 1
            Else
              dArr(ik, 3) = dArr(ik, 3) + 1
            End If
          End If
        End If
    Next i
    Set Dic = Nothing
With Sheets("Sheet2")
    If k Then .Range("O3:Q3").Resize(k).Value = dArr
End With
End Sub

befaint · 18/10/18

HieuCD đã viết:
If ik > 0 Then
'..
If k Then

Hình như không cần 2 chỗ này á anh.

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ó

Chuyên gia GPE

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

Ăn cùng góc phố

Chuyên gia GPE

Thành viên gắn bó

Thành viên mới

File đính kèm

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

Thành viên mới

Ăn cùng góc phố

Biên Hòa, Đồng Nai

Thành viên mới

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

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

GPE - My love

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

Chuyên gia GPE

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

Chuyên gia GPE

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

Facebook

Group