Trợ giúp học VBA - Excel

[Yeuvoyeucon]

Kính gửi Anh chị,
E chỉ biết VBA qua những thao tác Record Macro và nay muốn tìm hiểu lại. Nhờ các anh chị cho một số cách giải để làm được kết quả như vùng bôi vàng mà em làm bằng hàm ạ. Em cảm ơn ạ.

 

[giaiphap]

Kính gửi Anh chị,
E chỉ biết VBA qua những thao tác Record Macro và nay muốn tìm hiểu lại. Nhờ các anh chị cho một số cách giải để làm được kết quả như vùng bôi vàng mà em làm bằng hàm ạ. Em cảm ơn ạ.

Trước hết để được giúp bạn nên sửa lại tiêu đề cho phù hợp với vấn đề bạn cần nhờ.

 

[snow25]

Kính gửi Anh chị,
E chỉ biết VBA qua những thao tác Record Macro và nay muốn tìm hiểu lại. Nhờ các anh chị cho một số cách giải để làm được kết quả như vùng bôi vàng mà em làm bằng hàm ạ. Em cảm ơn ạ.

Bạn thử code này.

Sub diendulieu()
    Dim dic As Object, i As Long, a As Long, arr, kq, b As Long, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("Dem khong lap")
         arr = .Range("C4:D14").Value
         ReDim kq(1 To UBound(arr), 1 To 3)
         For i = 1 To UBound(arr)
             dk = arr(i, 1)
             If Not dic.exists(dk) Then
                a = a + 1
                dic.Add dk, a
                kq(a, 1) = dk
                kq(a, 2) = arr(i, 2)
                kq(a, 3) = 1
             Else
                b = dic.Item(dk)
                kq(b, 2) = kq(b, 2) + arr(i, 2)
                kq(b, 3) = kq(b, 3) + 1
             End If
         Next i
         .Range("K8:M8").Resize(a).Value = kq
   End With
End Sub

 

[Yeuvoyeucon]

Bạn thử code này.

Sub diendulieu()
    Dim dic As Object, i As Long, a As Long, arr, kq, b As Long, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("Dem khong lap")
         arr = .Range("C4:D14").Value
         ReDim kq(1 To UBound(arr), 1 To 3)
         For i = 1 To UBound(arr)
             dk = arr(i, 1)
             If Not dic.exists(dk) Then
                a = a + 1
                dic.Add dk, a
                kq(a, 1) = dk
                kq(a, 2) = arr(i, 2)
                kq(a, 3) = 1
             Else
                b = dic.Item(dk)
                kq(b, 2) = kq(b, 2) + arr(i, 2)
                kq(b, 3) = kq(b, 3) + 1
             End If
         Next i
         .Range("K8:M8").Resize(a).Value = kq
   End With
End Sub

Em cảm ơn anh đã giúp đỡ ạ.

 

[SA_DQ]

1 cách giải khác:
Chép cột C đến cột F, bắt đầu F7;
Tiến hành xóa trùng
Duyệt theo những gì còn lại dưới F7
Dùng hàm DSUM() tính * điền vô cột kề phải với cột F
Cột H bạn đã làm rồi, & hoàn toàn có thể xài trong VBA
Chúc vui & thành công!

 

[VetMini]

Rốt cuộc thì thớt nhờ trợ giúp học hay trợ giúp vấn đề?
Giúp viết code VBA hay viết giúp code VBA?