Sao chép dữ liệu và chuyển dữ liệu theo điều kiện

Đ

Đỗ Uyên

Yêu THVBA
em xin chào Anh/ Chị!

Hiện tại, em đang có file "Hàng Hóa" (giống file đính kèm). Em muốn chạy code VBA cho file theo những yêu cầu sau:
- Khi nhập liệu vào sheet "Data_Hang", nếu ô "Ngày Thanh Toán" = "Chưa Thanh toán" thì dòng đó sẽ cập nhập sang sheets "Cno_CTT"
nếu ô "Ngày Thanh Toán" = "Ngày" thì dòng đó sẽ cập nhập sang sheets "Cno_DTT"
- Nhưng sheet "Cno_CTT" chỉ lấy dữ liệu duy nhất và sẽ là tổng giá trị trùng lặp ở sheet "Data_hang"
- Nếu ô "Ngày Thanh toán" ở sheet "Cno_CTT" có nhập ngày thì dữ diệu sẽ chuyển qua sheet "Cno_DTT" và sẽ tự động xóa ở sheet "Cno_CTT"

Do em có tìm tòi trên mạng và thử chạy code nhiều lần nhưng vẫn chưa . Nay em lên xin nhờ các anh chị giúp đỡ.
Và có sai sót nào trong bài viết mong các anh/ chị bỏ qua
em xin cảm ơn nhiều ạ
Bạn cần đăng nhập để thấy link
 
H

HUONGLIEN7214

Yêu THVBA
Đỗ Uyên nói:
em xin chào Anh/ Chị!

Hiện tại, em đang có file "Hàng Hóa" (giống file đính kèm). Em muốn chạy code VBA cho file theo những yêu cầu sau:
- Khi nhập liệu vào sheet "Data_Hang", nếu ô "Ngày Thanh Toán" = "Chưa Thanh toán" thì dòng đó sẽ cập nhập sang sheets "Cno_CTT"
nếu ô "Ngày Thanh Toán" = "Ngày" thì dòng đó sẽ cập nhập sang sheets "Cno_DTT"
- Nhưng sheet "Cno_CTT" chỉ lấy dữ liệu duy nhất và sẽ là tổng giá trị trùng lặp ở sheet "Data_hang"
- Nếu ô "Ngày Thanh toán" ở sheet "Cno_CTT" có nhập ngày thì dữ diệu sẽ chuyển qua sheet "Cno_DTT" và sẽ tự động xóa ở sheet "Cno_CTT"

Do em có tìm tòi trên mạng và thử chạy code nhiều lần nhưng vẫn chưa . Nay em lên xin nhờ các anh chị giúp đỡ.
Và có sai sót nào trong bài viết mong các anh/ chị bỏ qua
em xin cảm ơn nhiều ạ
Bạn cần đăng nhập để thấy link
Nhấn để mở rộng...
Bạn thử với code sau:
Mã: 
Option Explicit

Sub TongHop()
Dim i&, j&, t&, k&, Lr&, R&, C&, n&
Dim Arr(), Res1(), Res2(), S, Key
Dim Dic As Object, Rng As Range, eRng As Range
Dim ShCTT As Worksheet, ShDTT As Worksheet, Ws As Worksheet

Set Ws = Sheets("Data_Hang")
Lr = Ws.Cells(Rows.Count, 2).End(xlUp).Row
Arr = Ws.Range("A4:L" & Lr).Value
R = UBound(Arr)
S = Array(, , 2, 11, 9, 8, 12, 10)
C = UBound(S)
Set Dic = CreateObject("Scripting.Dictionary")
ReDim Res1(1 To R, 1 To 7)
ReDim Res2(1 To R, 1 To 7)
For i = 1 To R
    If Arr(i, 12) = "CHƯA THANH TOÁN" Then
         Key = Arr(i, 11)
        If Not Dic.Exists(Key) Then
            t = t + 1: Dic.Add (Key), t
            Res1(t, 1) = t
            For j = 2 To C
                Res1(t, j) = Arr(i, S(j))
            Next j
        Else
            k = Dic.Item(Key)
                Res1(k, 5) = Res1(k, 5) + Arr(i, 8)
        End If
    ElseIf IsDate(Arr(i, 12)) Then
        n = n + 1:
            For j = 2 To C
                Res2(n, j) = Arr(i, S(j))
            Next j
            If Rng Is Nothing Then
                Set Rng = Ws.Range("A" & i + 3, "L" & i + 3)
            Else
               Set Rng = Union(Rng, Ws.Range("A" & i + 3, "L" & i + 3))
            End If
    End If
Next i
   Rng.Select:          Rng.Delete
If t Then
    Set ShCTT = Sheets("Cno_CTT")
        ShCTT.Range("A4").Resize(t, 7) = Res1
    Set ShDTT = Sheets("Cno_DTT")
        ShDTT.Range("A4").Resize(n, 7) = Res2
End If
End
End Sub
 
Đ

Đỗ Uyên

Yêu THVBA
HUONGLIEN7214 nói:
Bạn thử với code sau:
Mã: 
Option Explicit

Sub TongHop()
Dim i&, j&, t&, k&, Lr&, R&, C&, n&
Dim Arr(), Res1(), Res2(), S, Key
Dim Dic As Object, Rng As Range, eRng As Range
Dim ShCTT As Worksheet, ShDTT As Worksheet, Ws As Worksheet

Set Ws = Sheets("Data_Hang")
Lr = Ws.Cells(Rows.Count, 2).End(xlUp).Row
Arr = Ws.Range("A4:L" & Lr).Value
R = UBound(Arr)
S = Array(, , 2, 11, 9, 8, 12, 10)
C = UBound(S)
Set Dic = CreateObject("Scripting.Dictionary")
ReDim Res1(1 To R, 1 To 7)
ReDim Res2(1 To R, 1 To 7)
For i = 1 To R
    If Arr(i, 12) = "CHƯA THANH TOÁN" Then
         Key = Arr(i, 11)
        If Not Dic.Exists(Key) Then
            t = t + 1: Dic.Add (Key), t
            Res1(t, 1) = t
            For j = 2 To C
                Res1(t, j) = Arr(i, S(j))
            Next j
        Else
            k = Dic.Item(Key)
                Res1(k, 5) = Res1(k, 5) + Arr(i, 8)
        End If
    ElseIf IsDate(Arr(i, 12)) Then
        n = n + 1:
            For j = 2 To C
                Res2(n, j) = Arr(i, S(j))
            Next j
            If Rng Is Nothing Then
                Set Rng = Ws.Range("A" & i + 3, "L" & i + 3)
            Else
               Set Rng = Union(Rng, Ws.Range("A" & i + 3, "L" & i + 3))
            End If
    End If
Next i
   Rng.Select:          Rng.Delete
If t Then
    Set ShCTT = Sheets("Cno_CTT")
        ShCTT.Range("A4").Resize(t, 7) = Res1
    Set ShDTT = Sheets("Cno_DTT")
        ShDTT.Range("A4").Resize(n, 7) = Res2
End If
End
End Sub

Em cảm ơn Anh/Chị nhiều lắm ạ
Nhấn để mở rộng...
 
Bạn phải đăng nhập hoặc đăng ký để bình luận.
Top