vanvan9697
Thành viên chính thức
- Tham gia
- 11/5/12
- Bài viết
- 94
- Được thích
- 5
Em chào anh (chị) Diễn đàn Giaiphapexcel.com.vn. Em có một vấn sau mong muốn anh ( chị) trên diễn đàn giúp em ạ
Em Có sử dụng đoạn code trên để chuyển vùng dữ liệu từ A2:E Với kết quả mong muốn là vùng Dữ liệu từ H2: M với những điều kiện như sau:
Nếu trong cùng 1 tháng và cùng Mã thì sẽ được chuyển dữ liệu từ dạng 1 cột TK và 1 cột TK đối ứng sang 1 cột tài khoản và 2 cột Số tiền nợ và Số tiền có
Cột số thứ tự được đánh theo liên tiếp với điều kiện
Tuy nhiên code trên vẫn chưa chuyển đúng ạ !, em mong anh (chị) sửa giúp em ạ
Em Cảm ơn anh ( chị) trên diễn đàn đã giúp đỡ em ạ !
Em Có sử dụng đoạn code trên để chuyển vùng dữ liệu từ A2:E Với kết quả mong muốn là vùng Dữ liệu từ H2: M với những điều kiện như sau:
Nếu trong cùng 1 tháng và cùng Mã thì sẽ được chuyển dữ liệu từ dạng 1 cột TK và 1 cột TK đối ứng sang 1 cột tài khoản và 2 cột Số tiền nợ và Số tiền có
Cột số thứ tự được đánh theo liên tiếp với điều kiện
Tuy nhiên code trên vẫn chưa chuyển đúng ạ !, em mong anh (chị) sửa giúp em ạ
Em Cảm ơn anh ( chị) trên diễn đàn đã giúp đỡ em ạ !
Mã:
Sub ChenDongThem()
Dim Arr(), ArrPhanTich(), Dic As Object
Dim J As Long, W As Long
Dim StrC As String
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
ArrPhanTich = .Range("A2:e" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
End With
ReDim Arr(1 To UBound(ArrPhanTich, 1) * 3, 1 To 4)
For J = 1 To UBound(ArrPhanTich, 1)
StrC = ArrPhanTich(J, 1) & "#" & ArrPhanTich(J, 4)
If Not Dic.exists(StrC) Then
W = W + 2
Dic.Add StrC, W
Arr(W, 1) = ArrPhanTich(J, 1)
Arr(W, 2) = ArrPhanTich(J, 2)
Arr(W, 3) = Arr(W, 3) + ArrPhanTich(J, 3)
Arr(W, 4) = Arr(W, 4)
Else
W = W + 1
Arr(W, 1) = ArrPhanTich(J, 1)
Arr(W, 2) = ArrPhanTich(J, 2)
Arr(W, 3) = Arr(W, 3) + ArrPhanTich(J, 3)
Arr(W, 4) = Arr(W, 4)
End If
Next J
Sheet1.Range("02").Resize(W, 4).Value = Arr() '!!!'
End Sub