Code VBA không dán kết quả ra FORM_MAU

[hambaba]

Chào Anh/Chị,

Em học lõm trên mạng về việc viết code VBA tách dữ liệu trong sheet AGING_REPORT sang sheet FORM_MAU, em nhìn cũng làm theo các bước được hướng dẫn rồi mà không biết sao code không trả kết quả ra được. Em post lên đây, nhờ anh/chị hỗ trợ xem giúp em 1 cái xem sao nhé. Vì là học lõm theo video nên em không hiểu chuyên sâu, kính mong anh/chị mình thông cảm giúp em ạ.

File này mục đích của em là tách dữ liệu công nợ của từng sales ra các file excel riêng biệt dưới tên mỗi sales, việc tách file thì em thấy chạy được rồi, riêng phần dữ liệu lại bị trống.

Em cảm ơn ạ.

 

[BuiQuangThuan]

File này mục đích của em là tách dữ liệu công nợ của từng sales ra các file excel riêng biệt dưới tên mỗi sales, việc tách file thì em thấy chạy được rồi, riêng phần dữ liệu lại bị trống.

Em cảm ơn ạ.

sửa chỗ này coi. Thay sub cũ bằng sub này

Sub LocDuLieu()
    Dim i As Long, j As Long, lr As Long, arr(), kq(), a As Long, TenSales As String
    Dim shNguon As Worksheet, shDich As Worksheet
    Set shNguon = ThisWorkbook.Sheets("Aging_Report")
    Set shDich = ThisWorkbook.Sheets("Form_Mau")
    TenSales = shDich.Range("C2").Value
    
    ' Buoc 1: dua du lieu goc vao mang
    With shNguon
        lr = .Range("A" & Rows.Count).End(xlUp).Row 'tim dong cuoi
        arr = .Range("A5:S" & lr).Value 'gan cot ten sales vao mang
        ReDim kq(1 To UBound(arr, 1), 1 To UBound(arr, 2))
    End With
    
    ' Buoc 2: chay vong lap lay ket qua thoa man theo ten sales
    For i = 1 To UBound(arr, 1)
        If arr(i, 1) = TenSales Then
            a = a + 1
            For j = 1 To UBound(arr, 2)
                kq(a, j) = arr(i, j)
            Next j
        End If
    Next i
    
    ' Buoc 3: dan ket qua ra sheet form mau
    With shDich
        .Range("A5:S10000").ClearContents
        If a > 0 Then
            .Range("A5").Resize(a, UBound(arr, 2)).Value = kq 'dan ket qua ra
        End If
    End With
    
End Sub

 

[hambaba]

sửa chỗ này coi. Thay sub cũ bằng sub này

Sub LocDuLieu()
    Dim i As Long, j As Long, lr As Long, arr(), kq(), a As Long, TenSales As String
    Dim shNguon As Worksheet, shDich As Worksheet
    Set shNguon = ThisWorkbook.Sheets("Aging_Report")
    Set shDich = ThisWorkbook.Sheets("Form_Mau")
    TenSales = shDich.Range("C2").Value
   
    ' Buoc 1: dua du lieu goc vao mang
    With shNguon
        lr = .Range("A" & Rows.Count).End(xlUp).Row 'tim dong cuoi
        arr = .Range("A5:S" & lr).Value 'gan cot ten sales vao mang
        ReDim kq(1 To UBound(arr, 1), 1 To UBound(arr, 2))
    End With
   
    ' Buoc 2: chay vong lap lay ket qua thoa man theo ten sales
    For i = 1 To UBound(arr, 1)
        If arr(i, 1) = TenSales Then
            a = a + 1
            For j = 1 To UBound(arr, 2)
                kq(a, j) = arr(i, j)
            Next j
        End If
    Next i
   
    ' Buoc 3: dan ket qua ra sheet form mau
    With shDich
        .Range("A5:S10000").ClearContents
        If a > 0 Then
            .Range("A5").Resize(a, UBound(arr, 2)).Value = kq 'dan ket qua ra
        End If
    End With
   
End Sub

dạ em copy vào và file chạy được rồi. cảm ơn anh nhiều nhé <3

 

[hambaba]

sửa chỗ này coi. Thay sub cũ bằng sub này

Sub LocDuLieu()
    Dim i As Long, j As Long, lr As Long, arr(), kq(), a As Long, TenSales As String
    Dim shNguon As Worksheet, shDich As Worksheet
    Set shNguon = ThisWorkbook.Sheets("Aging_Report")
    Set shDich = ThisWorkbook.Sheets("Form_Mau")
    TenSales = shDich.Range("C2").Value
   
    ' Buoc 1: dua du lieu goc vao mang
    With shNguon
        lr = .Range("A" & Rows.Count).End(xlUp).Row 'tim dong cuoi
        arr = .Range("A5:S" & lr).Value 'gan cot ten sales vao mang
        ReDim kq(1 To UBound(arr, 1), 1 To UBound(arr, 2))
    End With
   
    ' Buoc 2: chay vong lap lay ket qua thoa man theo ten sales
    For i = 1 To UBound(arr, 1)
        If arr(i, 1) = TenSales Then
            a = a + 1
            For j = 1 To UBound(arr, 2)
                kq(a, j) = arr(i, j)
            Next j
        End If
    Next i
   
    ' Buoc 3: dan ket qua ra sheet form mau
    With shDich
        .Range("A5:S10000").ClearContents
        If a > 0 Then
            .Range("A5").Resize(a, UBound(arr, 2)).Value = kq 'dan ket qua ra
        End If
    End With
   
End Sub

dạ anh cho em hỏi thêm 1 cái, em muốn giữ nguyên format của dữ liệu gốc khi lọc ra file riêng, nghĩa là file gốc tô màu, in đậm,... như thế nào thì file riêng lọc ra cũng như vậy, mình có cách nào để làm được không anh? nhờ anh chỉ em thêm 1 bước này nhé. em cảm ơn ạ.

 

[BuiQuangThuan]

dạ anh cho em hỏi thêm 1 cái, em muốn giữ nguyên format của dữ liệu gốc khi lọc ra file riêng, nghĩa là file gốc tô màu, in đậm,... như thế nào thì file riêng lọc ra cũng như vậy, mình có cách nào để làm được không anh? nhờ anh chỉ em thêm 1 bước này nhé. em cảm ơn ạ.

Được bạn ạ... . . . . .