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

[maytinhvp01]

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]

 

[LamTran0202]

Help me....! mình có 1 file xecell gồm 2 sheet (data và packing) bên sheet data mình có cột A là tên chi tiết mình muốn dùng 1 đoạ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 có một vài ô không có dư liệu thì không copy. nếu dùng autofillter rồi copy/past vẫn đc nhừng mình muốn ứng dung VBA để học hỏi, có ai giúp mình đoạn code.

 

[♫ђöล♥ßล†♥†µ♫]

Help me....! mình có 1 file xecell gồm 2 sheet (data và packing) bên sheet data mình có cột A là tên chi tiết mình muốn dùng 1 đoạ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 có một vài ô không có dư liệu thì không copy. nếu dùng autofillter rồi copy/past vẫn đc nhừng mình muốn ứng dung VBA để học hỏi, có ai giúp mình đoạ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]

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]

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]

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]

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]

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!

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

 

[♫ђöล♥ßล†♥†µ♫]

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!

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

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]

Bạn thử như vầy xem

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ỉ?

 

[♫ђöล♥ßล†♥†µ♫]

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]

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

 

[♫ђöล♥ßล†♥†µ♫]

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]

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

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]

If ik > 0 Then
'..
If k Then

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

 

[HieuCD]

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

♫ђöล♥ßล†♥†µ♫ làm mình bối rối, theo quán tính nhập thừa 2 lệnh if

 

[Phan Thế Hiệp]

♫ђöล♥ßล†♥†µ♫ làm mình bối rối,

Sao vậy anh!?

Có cần cho "cô nương" ấy 1 ca H2SO4 đậm đặc không!?

Khà khà khà

 

[HieuCD]

Sao vậy anh!?

Có cần cho "cô nương" ấy 1 ca H2SO4 đậm đặc không!?

Khà khà khà

Chỉ cần 1 lon "Bò húc" là đủ

 

[Lequocvan]

Tuyệt cú mèo, yêu thế cơ chứ! Cảm ơn Chị nhé!

 

[LCTAI]

Dạ chào các anh chị
Em mới tìm hiểu lập trình VBA, khi chạy đoạn code này nó báo lỗi. Em không biết lỗi thế nào, anh chị giúp em với

 

[Hoàng Nhật Phương]

Dạ chào các anh chị
Em mới tìm hiểu lập trình VBA, khi chạy đoạn code này nó báo lỗi. Em không biết lỗi thế nào, anh chị giúp em với
View attachment 206089

Bạn thử cho DATA vào trong dấu "" thành "DATA" xem được không ạ?