Xin giúp code lấy dữ liệu từ 2 Sheet (1 người xem)

[levanhoa1977]

ACE giúp code lấy dữ liệu từ 2 sheet. Khi điền mã cột J2 Thì dữ liệu lấy từ bảng chi tiết theo khách hàng đó cộng theo ngày ( cột a). Và nhóm sản phẩm dòng 12. Cột J14:J sẽ được cộng theo ngày và khách hàng đó luôn nhưng lấy dữ liệu từ sheet THU CHI.
Cảm ơn nhiều

 

[giangleloi]

ACE giúp code lấy dữ liệu từ 2 sheet. Khi điền mã cột J2 Thì dữ liệu lấy từ bảng chi tiết theo khách hàng đó cộng theo ngày ( cột a). Và nhóm sản phẩm dòng 12. Cột J14:J sẽ được cộng theo ngày và khách hàng đó luôn nhưng lấy dữ liệu từ sheet THU CHI.
Cảm ơn nhiều

Cộng số lượng hay thành tiền từ sheet "CHI TIET" qua vậy nè? Sao không nhập vài kết quả mong muốn để có thể dễ hình dung hơn.

 

[levanhoa1977]

Cộng số lượng hay thành tiền từ sheet "CHI TIET" qua vậy nè? Sao không nhập vài kết quả mong muốn để có thể dễ hình dung hơn.

Công nợ là thành tiền rồi.

 

[AutoReply]

File download về có Open được đâu? Open là excel treo luôn....và Đứng luôn....và không có mở được... sao vậy nè?

cái này mở được nè anh ơi

 

[levanhoa1977]

File mở bình thường mà.

 

[giangleloi]

Công nợ là thành tiền rồi.

Công nợ là việc của bạn. Tui chỉ quan tâm kết quả bạn mong muốn thôi. Chạy thử và phản hồi lại nhé

Sub GLL()
Dim Arr, vlArr(1 To 10000, 1 To 6), DL, I, J, Dic, Tem, x
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("CHI TIET")
Arr = .Range(.[C3], .[Z65000].End(3)).Value
End With
For I = 1 To UBound(Arr, 1)
 Tem = Arr(I, 24) & "#" & Arr(I, 1)
  If Not Dic.exists(Tem) Then
    Dic.Add Tem, Arr(I, 17)
   Else
    Dic.Item(Tem) = Dic.Item(Tem) + Arr(I, 17)
  End If
Next I
With Sheets("CONG NO")
DL = .[A14:A379].Value
x = .[C12:H12].Value
 For I = 1 To UBound(DL, 1)
   For J = 1 To 6
      Tem = DL(I, 1) & "#" & x(1, J)
      If Dic.exists(Tem) Then
         vlArr(I, J) = Dic.Item(Tem)
      End If
   Next J
 Next I
.[C14].Resize(I, 6) = vlArr
End With
End Sub

P/s: Mới chỉ làm lấy từ sheet CHI TIET lấy qua thôi nha. OK thì làm tiếp.

 

[levanhoa1977]

File của bạn mở không được...Tôi download của bạn ở #5... Bạn chạy code sau và test thử đã được chưa?

Option Explicit
Public Sub GPE()
Dim Dic As Object, sArr, dArr, Arr, I&, J&, K&, Tem, KH As String
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet10
    sArr = .Range("A14:A379").Value
    Arr = .Range("C12:H12").Value
    KH = .Range("J2").Value
End With
ReDim dArr(1 To UBound(sArr), 1 To 6)
    For I = 1 To UBound(sArr)
        Tem = sArr(I, 1)
        If Not Dic.Exists(Tem) Then
            K = K + 1
            Dic.Add Tem, K
        End If
    Next I
With Sheet6
    sArr = .Range("A3", .Range("A65000").End(3)).Resize(, 34).Value
End With
For I = 1 To UBound(sArr)
If sArr(I, 6) = KH Then
    Tem = sArr(I, 26)
    If Dic.Exists(Tem) Then
        For J = 1 To UBound(Arr, 2)
            If sArr(I, 3) = Arr(1, J) Then
                dArr(Dic.Item(Tem), J) = dArr(Dic.Item(Tem), J) + sArr(I, 19)
            End If
        Next J
    End If
End If
Next I
With Sheet10
    .Range("C14:H379").ClearContents
    .Range("C14").Resize(K, 6).Value = dArr
End With
Set Dic = Nothing
End Sub

Cảm ơn bạn. Còn tiền phải thu J14:J lấy từ sheet THU CHI cũng dựa vào Mã KH và ngày chưa load được.

 

[levanhoa1977]

Công nợ là việc của bạn. Tui chỉ quan tâm kết quả bạn mong muốn thôi. Chạy thử và phản hồi lại nhé

Sub GLL()
Dim Arr, vlArr(1 To 10000, 1 To 6), DL, I, J, Dic, Tem, x
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("CHI TIET")
Arr = .Range(.[C3], .[Z65000].End(3)).Value
End With
For I = 1 To UBound(Arr, 1)
 Tem = Arr(I, 24) & "#" & Arr(I, 1)
  If Not Dic.exists(Tem) Then
    Dic.Add Tem, Arr(I, 17)
   Else
    Dic.Item(Tem) = Dic.Item(Tem) + Arr(I, 17)
  End If
Next I
With Sheets("CONG NO")
DL = .[A14:A379].Value
x = .[C12:H12].Value
 For I = 1 To UBound(DL, 1)
   For J = 1 To 6
      Tem = DL(I, 1) & "#" & x(1, J)
      If Dic.exists(Tem) Then
         vlArr(I, J) = Dic.Item(Tem)
      End If
   Next J
 Next I
.[C14].Resize(I, 6) = vlArr
End With
End Sub

P/s: Mới chỉ làm lấy từ sheet CHI TIET lấy qua thôi nha. OK thì làm tiếp.

Kết quả ra ko đúng bạn. Code của bạn hpkhuong thì ok. Nhưng chỉ mới phần đầu. Còn lấy từ sheet thu chi thì chưa.

 

[giangleloi]

Kết quả ra ko đúng bạn. Code của bạn hpkhuong thì ok. Nhưng chỉ mới phần đầu. Còn lấy từ sheet thu chi thì chưa.

Nhìn code bài trên mới thấy là phải cộng theo khách hàng nữa. Tui chỉ mới cộng theo mặt hàng nên chưa có ra đúng. Bạn đợi "chàng" ấy viết tiếp đi nha.

 

[Ba Tê]

ACE giúp code lấy dữ liệu từ 2 sheet. Khi điền mã cột J2 Thì dữ liệu lấy từ bảng chi tiết theo khách hàng đó cộng theo ngày ( cột a). Và nhóm sản phẩm dòng 12. Cột J14:J sẽ được cộng theo ngày và khách hàng đó luôn nhưng lấy dữ liệu từ sheet THU CHI.
Cảm ơn nhiều

Cấu trúc dữ liệu như vậy e là ... "đắm đuối".
Kết quả sao phải có đủ các ngày trong năm?
Mã Khách hàng nhập "từa lưa" không có trong sheet CHI TIẾT thì sao?
Xem thử file này, tổng theo ngày, ngày nào có trong CHI TIET thì "kê khai ra", không có thì thôi.
Chọn mã KH trong ô J2.
Hổng chịu thì "chạy".

 

[levanhoa1977]

Cấu trúc dữ liệu như vậy e là ... "đắm đuối".
Kết quả sao phải có đủ các ngày trong năm?
Mã Khách hàng nhập "từa lưa" không có trong sheet CHI TIẾT thì sao?
Xem thử file này, tổng theo ngày, ngày nào có trong CHI TIET thì "kê khai ra", không có thì thôi.
Chọn mã KH trong ô J2.
Hổng chịu thì "chạy".

Đây là một phần của file dĩ nhiên trong file còn sheet khách hàng nhưng cắt ra cho file nhẹ bớt. Kết quả ok nhưng những theo mình nghĩ đâu cần shetes mã khách hàng.

 

[levanhoa1977]

Hên xui nhé!

Option Explicit
Public Sub GPE()
Dim Dic As Object, sArr, dArr, Arr, I&, J&, K&, Tem, KH As String, kArr
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet10
    sArr = .Range("A14:A379").Value
    Arr = .Range("C12:H12").Value
    KH = .Range("J2").Value
End With
With Sheet8
    kArr = .Range("A13", .Range("A65000").End(3)).Resize(, 7).Value
End With
ReDim dArr(1 To UBound(sArr), 1 To 8)
    For I = 1 To UBound(sArr)
        Tem = sArr(I, 1)
        If Not Dic.Exists(Tem) Then
            K = K + 1
            Dic.Add Tem, K
        End If
    Next I
With Sheet6
    sArr = .Range("A3", .Range("A65000").End(3)).Resize(, 34).Value
End With


For I = 1 To UBound(sArr)
If sArr(I, 6) = KH Then
    Tem = sArr(I, 26)
    If Dic.Exists(Tem) Then
        For J = 1 To UBound(Arr, 2)
            If sArr(I, 3) = Arr(1, J) Then
                dArr(Dic.Item(Tem), J) = dArr(Dic.Item(Tem), J) + sArr(I, 19)
                dArr(Dic.Item(Tem), 7) = dArr(Dic.Item(Tem), 7) + sArr(I, 19)
            End If
        Next J
    End If
End If
Next I


For I = 1 To UBound(kArr)
If kArr(I, 4) = KH Then
    Tem = kArr(I, 1)
    If Dic.Exists(Tem) Then
        dArr(Dic.Item(Tem), 8) = dArr(Dic.Item(Tem), 8) + kArr(I, 7)
    End If
End If
Next I


With Sheet10
    .Range("C14:J379").ClearContents
    .Range("C14").Resize(K, 8).Value = dArr
End With
Set Dic = Nothing
End Sub

Ok được rồi. Cảm ơn bạn mình chỉ là tay vba rùa. Sử dụng công thức thì file chậm hơn rùa. Hihi,

 

[levanhoa1977]

Cảm ơn mọi người nhiều nhiều. Làm được rồi