Nhờ sửa đoạn code tính tổng trùng

[tanthanh94]

Các anh xem đoạn code của em sai chỗ nào

Private Sub CommandButton1_Click()
Dim Arr(), Darr(), I, J, K, Dic As Object
Set Dic = CreateObject("scripting.dictionary")
Arr = Range("C5", [C5000].End(xlUp)).Resize(, 3).Value
ReDim Darr(1 To UBound(Arr, 1), 1 To 3)
For I = 1 To UBound(Arr, 1)
       If Not Dic.exists(Arr(I, 1)) Then
              K = K + 1
              Dic.Add Arr(I, 1), K
For J = 1 To 3
      Darr(K, J) = Arr(I, J)
      Next
      Darr(K, 3) = Arr(I, 3)
            Else
                 Darr(Dic.Item(Arr(I, 1), 3)) = Darr(Dic.Item(Arr(I, 1), 3)) + Arr(I, 3)
                 End If
                 Next
                 Range("H5").Resize(K, 3) = Darr
End Sub

 

[Ba Tê]

Các anh xem đoạn code của em sai chỗ nào

Private Sub CommandButton1_Click()
Dim Arr(), Darr(), I, J, K, Dic As Object
Set Dic = CreateObject("scripting.dictionary")
Arr = Range("B5", [B5000].End(xlUp)).Resize(, 3).Value
ReDim Darr(1 To UBound(Arr, 1), 1 To 3)
For I = 1 To UBound(Arr, 1)
       If Not Dic.exists(Arr(I, 1)) Then
              K = K + 1
              Dic.Add Arr(I, 1), K
For J = 1 To 3
      Darr(K, J) = Arr(I, J)
      Next
      Darr(K, 3) = Arr(I, 3)
            Else
                 Darr(Dic.Item(Arr(I, 1), 3)) = Darr(Dic.Item(Arr(I, 1), 3)) + Arr(I, 3)
                 End If
                 Next
                 Range("H5").Resize(K, 3) = Darr
End Sub

- Cột B trống rỗng mà khai báo câu này:

Arr = Range("B5", [B5000].End(xlUp)).Resize(, 3).Value

- Cái này đã nạp dArr(K,3) rồi.

For J = 1 To 3
      Darr(K, J) = Arr(I, J)
      Next

Thêm một dòng Darr(K, 3) = Arr(I, 3) là sao
- Xem lại vị trí mấy dấu ")" trong dòng này:

Darr(Dic.Item(Arr(I, 1), 3)) = Darr(Dic.Item(Arr(I, 1), 3)) + Arr(I, 3)

Thụt đầu dòng gì mà nhìn rối quá.
Thường thì người ta add mã, ai add Tên có dấu, dài ngoằn.

 

[tanthanh94]

- Cột B trống rỗng mà khai báo câu này:

Arr = Range("B5", [B5000].End(xlUp)).Resize(, 3).Value

- Cái này đã nạp dArr(K,3) rồi.

For J = 1 To 3
      Darr(K, J) = Arr(I, J)
      Next

Thêm một dòng Darr(K, 3) = Arr(I, 3) là sao
- Xem lại vị trí mấy dấu ")" trong dòng này:

Darr(Dic.Item(Arr(I, 1), 3)) = Darr(Dic.Item(Arr(I, 1), 3)) + Arr(I, 3)

Thụt đầu dòng gì mà nhìn rối quá.
Thường thì người ta add mã, ai add Tên có dấu, dài ngoằn.

Private Sub CommandButton1_Click()
Dim Arr(), Darr(), I, J, K, Dic As Object
Set Dic = CreateObject("scripting.dictionary")
Arr = Range("C5", [C5000].End(xlUp)).Resize(, 3).Value
ReDim Darr(1 To UBound(Arr, 1), 1 To 3)
For I = 1 To UBound(Arr, 1)
       If Not Dic.exists(Arr(I, 1)) Then
              K = K + 1
              Dic.Add Arr(I, 1), K
For J = 1 To 3
      Darr(K, J) = Arr(I, J)
      Next
            Else
                  Darr(Dic.Item(Arr(I, 1)), 3) = Darr(Dic.Item(Arr(I, 1)), 3) + Arr(I, 3)
                 End If
                 Next
                 Range("H5").Resize(K, 3) = Darr
End Sub

Em đang học cách dùng Dic ,mượn code trên diễn đàn chỉnh sửa từ từ
Cám ơn anh Ba Tê rất nhiều.

 

[comet_1701]

Private Sub CommandButton1_Click()
Dim Arr(), Darr(), I, J, K, Dic As Object
Set Dic = CreateObject("scripting.dictionary")
Arr = Range("C5", [C5000].End(xlUp)).Resize(, 3).Value
ReDim Darr(1 To UBound(Arr, 1), 1 To 3)
For I = 1 To UBound(Arr, 1)
       If Not Dic.exists(Arr(I, 1)) Then
              K = K + 1
              Dic.Add Arr(I, 1), K
For J = 1 To 3
      Darr(K, J) = Arr(I, J)
      Next
            Else
                  Darr(Dic.Item(Arr(I, 1)), 3) = Darr(Dic.Item(Arr(I, 1)), 3) + Arr(I, 3)
                 End If
                 Next
                 Range("H5").Resize(K, 3) = Darr
End Sub

Em đang học cách dùng Dic ,mượn code trên diễn đàn chỉnh sửa từ từ
Cám ơn anh Ba Tê rất nhiều.

Private Sub CommandButton1_Click()
Dim Arr(), Darr(), I, J, K, Dic As Object
Set Dic = CreateObject("scripting.dictionary")
Arr = Range("C5", [C5000].End(xlUp)).Resize(, 3).Value
ReDim Darr(1 To UBound(Arr, 1), 1 To 3)
For I = 1 To UBound(Arr, 1)
       If Not Dic.exists(Arr(I, 1)) Then
            K = K + 1
            Dic.Add Arr(I, 1), K
            For J = 1 To 3
                Darr(K, J) = Arr(I, J)
            Next
    
        Else
            Darr(Dic.Item(Arr(I, 1)), 3) = Darr(Dic.Item(Arr(I, 1)), 3) + Arr(I, 3)
        End If
Next
[H5:J5000].ClearContents
If K Then
    Range("H5").Resize(K, 3) = Darr
End If
Set Dic = Nothing
End Sub

Có thể thế này

 

[telenor]

chào a/c

cho em hỏi phím tắt để cho ẩn cột, dòng và cho hiện cột , dòng trong excel.

em tìm lâu rùi mà chưa biết?