Bài tập VBA - Macro

[ndu96081631]

kính gởi các bạn mới tập tành vba, tôi có một bài tập viết code vba cho sumif
các bạn cho ý kiến nha

Public Sub GPE()
Dim Dic As Object, sArr, v As Variant, I, Q As Long, key As String
Set Dic = CreateObject("Scripting.Dictionary")
[D5:D60000].ClearContents
sArr = Range([b5], [b5].End(xlDown)).Resize(, 3).Value2

For I = 1 To UBound(sArr, 1)
    key = sArr(I, 1)
    If Not Dic.Exists(key) Then
        Dic.Add key, I
        sArr(I, 3) = sArr(I, 2)
    Else
        Dic.Item(key) = Dic.Item(key) & "@" & I
        Q = sArr(Split(Dic.Item(key), "@")(0), 3)
        For Each v In Split(Dic.Item(key), "@")
           sArr(v, 3) = Q + sArr(I, 2)
        Next
    End If
Next I


[b5].Resize(I - 1, 3) = sArr
Set Dic = Nothing
End Sub

Mình nghĩ dùng 2 vòng lập tách rời sẽ nhanh hơn kiểu vòng lập trong vòng lập
Tức là thế này:

Public Sub GPE()
  Dim dic As Object, i As Long, sArr, key As String, item As Double
  Set dic = CreateObject("Scripting.Dictionary")
  [D5:D60000].ClearContents
  sArr = Range([b5], [b5].End(xlDown)).Resize(, 3).Value2
  For i = 1 To UBound(sArr, 1)
    key = sArr(i, 1): item = sArr(i, 2)
    If Not dic.Exists(key) Then
      dic.Add key, item
    Else
      dic.item(key) = dic.item(key) + item
    End If
  Next i
  For i = 1 To UBound(sArr, 1)
    key = sArr(i, 1)
    sArr(i, 3) = dic.item(key)
  Next i
  [b5].Resize(i - 1, 3) = sArr
  Set dic = Nothing
End Sub

Mới nghĩ sơ qua thôi, không chắc lắm
(cái mình chắc nhất là.. dễ hiểu. Ẹc... Ẹc...)

 

[Let'GâuGâu]

Mình nghĩ dùng 2 vòng lập tách rời sẽ nhanh hơn kiểu vòng lập trong vòng lập
Tức là thế này:

Mới nghĩ sơ qua thôi, không chắc lắm
(cái mình chắc nhất là.. dễ hiểu. Ẹc... Ẹc...)

hihihihi....đúng rồi, cách này mọi người vẫn hay sử dụng, tôi định phá cách rút ngắn vòng lặp......nhưng sau khi ngủ trưa dậy, đếm số vòng lặp còn nhiều hơn.............thôi bỏ ý định....hihihih
===========
hay là chơi kiểu rừng đi...........đông tây y kết hợp.....hehehhe

Public Sub GPE()
Dim Dic As Object, sArr, v As Variant, I, K As Long, key As String
Set Dic = CreateObject("Scripting.Dictionary")
[D5:D60000].ClearContents
sArr = Range([b5], [b5].End(xlDown)).Resize(, 3).Value2

For I = 1 To UBound(sArr, 1)
    key = sArr(I, 1)
    If Not Dic.Exists(key) Then
        Dic.Add key, I
        sArr(I, 3) = sArr(I, 2)
    Else
        K = Dic.Item(key)
        sArr(K, 3) = sArr(K, 3) + sArr(I, 2)
        sArr(I, 3) = "=R[-" & I - K & "]C"
    End If   
Next I
With [b5].Resize(I - 1, 3)
.Value = sArr
.Value = .Value
End With
Set Dic = Nothing
End Sub

 

[ndu96081631]

hay là chơi kiểu rừng đi...........đông tây y kết hợp.....hehehhe

Public Sub GPE()
........................

        K = Dic.Item(key)
        sArr(K, 3) = sArr(K, 3) + sArr(I, 2)
        sArr(I, 3) = "=R[-" & I - K & "]C"

............................
End Sub

Vậy sao mình hổng "rừng u minh" luôn, kiểu như:

   With Range("D5:D16")
     .Value = "=SUMIF(" & .Offset(, -2).Address(, , 2) & ", RC[-2] ," & .Offset(, -1).Address(, , 2) & ")"
     .Value = .Value
   End With

Khỏi vòng lập gì ráo! Ẹc... Ẹc...

 

[Châu Hoàn Vũ]

Tôi làm bài tập 5 của chị handung107, nhưng khi chạy cứ báo lỗi.
Tôi ghi lại lần lượt đã làm như sau: chọn vùng cần copy, copy, chọn một ô sẽ paste, ghi macro, edit, paste special, value, stop ghi macro.
Và kết quả như sau: "Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks :=False, Transpose:=False".
Các bạn làm ơn chỉ lỗi ở đâu?
Xin chân thành cám ơn.

Sub Copy()
Selection.Copy
End Sub

Sub Pasted()
‘ Paste phải dùng ActiveSheet.
ActiveSheet.Paste
End Sub