Điều Chỉnh Code (2 người xem)

[vuongtoituonglai]

Chào cả nhà GPE!
Với sheet "Ton Kho" mỗi lận chạy code điều chỉnh sao cho chỉ xóa vùng dữ liệu từ A5:F5 trở xuống(hiện tại là xóa từ A5:L5) mình chỉnh hoài mà không được nên nhờ các anh chị và các bạn giúp đỡ. Cảm ơn nhiều

 

[ChanhTQ@]

Iêu cầu của bạn chứng tỏ bạn chưa hiểu hết các câu lệnh trong macro.

Tựu chung, trong macro tác giả đã khai báo 1 mảng gồm 1.500 dòng & 12 cột để chứa dữ liệu đạt iêu cầu ở các trang tính "1", "2" & "3"

Sau đó kết quả này đưa thể hiện lên 12 cột & 1.500 dòng đó ở 'Ton Kho'

Bậy giờ bạn muốn nó thể hiện chỉ trong 7 cột thì sao mà được, nếu không viết lại macro?

(húc vui cuối tuần!

 

[mhung12005]

Chào cả nhà GPE!
Với sheet "Ton Kho" mỗi lận chạy code điều chỉnh sao cho chỉ xóa vùng dữ liệu từ A5:F5 trở xuống(hiện tại là xóa từ A5:L5) mình chỉnh hoài mà không được nên nhờ các anh chị và các bạn giúp đỡ. Cảm ơn nhiều

Sub TongHop()    
    Dim Tmp, Arr(), i As Long, k As Long
    ReDim Arr(1 To 1500, 1 To 12)
    Tmp = Sheets("1").[C5:N500]
    For i = 1 To UBound(Tmp)
        If IsEmpty(Tmp(i, 1)) Then Exit For
        k = k + 1
        Arr(k, 1) = k: Arr(k, 2) = Tmp(i, 1): Arr(k, 3) = Tmp(i, 3): Arr(k, 4) = Tmp(i, 5): Arr(k, 5) = Tmp(i, 7): Arr(k, 8) = Tmp(i, 12): Arr(k, 11) = Tmp(i, 10)
    Next
    Tmp = Sheets("2").[E5:M500]
    For i = 1 To UBound(Tmp)
        If IsEmpty(Tmp(i, 1)) Then Exit For
        k = k + 1
        Arr(k, 1) = k: Arr(k, 2) = Tmp(i, 1): Arr(k, 3) = Tmp(i, 3): Arr(k, 4) = Tmp(i, 5): Arr(k, 5) = Tmp(i, 9): Arr(k, 8) = Tmp(i, 2)
    Next
    Tmp = Sheets("3").[C5:K500]
    For i = 1 To UBound(Tmp)
        If IsEmpty(Tmp(i, 1)) Then Exit For
        k = k + 1
        Arr(k, 1) = k: Arr(k, 2) = Tmp(i, 1): Arr(k, 3) = Tmp(i, 5): Arr(k, 4) = Tmp(i, 7): Arr(k, 5) = Tmp(i, 9): Arr(k, 8) = Tmp(i, 3)
    Next
    With Sheets("Ton Kho")
        [COLOR=#ff0000].[A5:F1500].Clear[/COLOR]
        With .[A5].Resize(k, [SIZE=3][COLOR=#ff0000]6[/COLOR][/SIZE])
            .Value = Arr
            .Font.Name = "Courier New"
            .Font.Size = 10
        End With
        With .[F5].Resize(k)
            .NumberFormat = "#,##0"
            .Font.Size = 14
            .Font.Bold = True
            .Font.ColorIndex = 3
        End With
        With .[B5:D5].Resize(k)
            .Font.Size = 10
            .Font.ColorIndex = 1
        End With
        .[A4].Resize(k + 1, 11).Borders.LineStyle = 1
    End With
End Sub

Bạn sửa 2 chỗ "màu đỏ" là đc

 

[vuongtoituonglai]

Tựu chung, trong macro tác giả đã khai báo 1 mảng gồm 1.500 dòng & 12 cột để chứa dữ liệu đạt iêu cầu ở các trang tính "1", "2" & "3"

Sau đó kết quả này đưa thể hiện lên 12 cột & 1.500 dòng đó ở 'Ton Kho'

Bậy giờ bạn muốn nó thể hiện chỉ trong 7 cột thì sao mà được, nếu không viết lại macro?

(húc vui cuối tuần!

Cảm ơn bạn, mình không rành về code, bạn xem có giải pháp nào giúp được mình không. Cảm ơn.

 

[VetMini]

Cảm ơn bạn, mình không rành về code, bạn xem có giải pháp nào giúp được mình không. Cảm ơn.

Code mà bạn đưa ra đó là loại code "mì ăn liền". Người ta viết để giải quyết các trường hợp tại chỗ chứ không phải là loại code tổng quát để dùng chung cho nhiều trường hợp, chỉ cần dổi thông số.

Để chỉnh sửa code vào bài của bạn có thể còn tốn công nhiều hơn viết lại từ đầu. Vì vậy bạn nêu thẳng vấn đề của mình ra sẽ có người cho bạn một bát "mì ăn liền" khác nóng hổi hơn.

đính chính: từ "mì ăn liền" không có nghĩa xấu. Nó chỉ là cách diễn tả phương pháp viết code tại chỗ thôi. Tôi biết có nhiều truonwgf phải khẳng định rằng cách này hữu hiệu hơn cách của trường phái thủ tục cổ điển.

 

[vuongtoituonglai]

Sub TongHop()    
    Dim Tmp, Arr(), i As Long, k As Long
    ReDim Arr(1 To 1500, 1 To 12)
    Tmp = Sheets("1").[C5:N500]
    For i = 1 To UBound(Tmp)
        If IsEmpty(Tmp(i, 1)) Then Exit For
        k = k + 1
        Arr(k, 1) = k: Arr(k, 2) = Tmp(i, 1): Arr(k, 3) = Tmp(i, 3): Arr(k, 4) = Tmp(i, 5): Arr(k, 5) = Tmp(i, 7): Arr(k, 8) = Tmp(i, 12): Arr(k, 11) = Tmp(i, 10)
    Next
    Tmp = Sheets("2").[E5:M500]
    For i = 1 To UBound(Tmp)
        If IsEmpty(Tmp(i, 1)) Then Exit For
        k = k + 1
        Arr(k, 1) = k: Arr(k, 2) = Tmp(i, 1): Arr(k, 3) = Tmp(i, 3): Arr(k, 4) = Tmp(i, 5): Arr(k, 5) = Tmp(i, 9): Arr(k, 8) = Tmp(i, 2)
    Next
    Tmp = Sheets("3").[C5:K500]
    For i = 1 To UBound(Tmp)
        If IsEmpty(Tmp(i, 1)) Then Exit For
        k = k + 1
        Arr(k, 1) = k: Arr(k, 2) = Tmp(i, 1): Arr(k, 3) = Tmp(i, 5): Arr(k, 4) = Tmp(i, 7): Arr(k, 5) = Tmp(i, 9): Arr(k, 8) = Tmp(i, 3)
    Next
    With Sheets("Ton Kho")
        [COLOR=#ff0000].[A5:F1500].Clear[/COLOR]
        With .[A5].Resize(k, [SIZE=3][COLOR=#ff0000]6[/COLOR][/SIZE])
            .Value = Arr
            .Font.Name = "Courier New"
            .Font.Size = 10
        End With
        With .[F5].Resize(k)
            .NumberFormat = "#,##0"
            .Font.Size = 14
            .Font.Bold = True
            .Font.ColorIndex = 3
        End With
        With .[B5:D5].Resize(k)
            .Font.Size = 10
            .Font.ColorIndex = 1
        End With
        .[A4].Resize(k + 1, 11).Borders.LineStyle = 1
    End With
End Sub

Bạn sửa 2 chỗ "màu đỏ" là đc

Cảm ơn bạn. Chỉnh code như vậy thì không lấy được du liệu từ các sheet sang cột K của sheet ' Ton Kho'. Bạn tiếp tục nghiên cứu giúp mình. Cảm ơn bạn.

 

[mhung12005]

Cảm ơn bạn. Chỉnh code như vậy thì không lấy được du liệu từ các sheet sang cột K của sheet ' Ton Kho'. Bạn tiếp tục nghiên cứu giúp mình. Cảm ơn bạn.

Bạn dùng thử code này xem sao.

Sub TongHop()
    Dim Tmp, Arr(), i As Long, k As Long
    ReDim Arr(1 To 1500, 1 To 12)
    Application.ScreenUpdating = False
    With Sheets("Ton Kho")
    Union(Range("A5:F1500"), Range("H5:H1500"), Range("J5:K1500")).Clear
    Tmp = Sheets("1").[C5:N500]
    For i = 1 To UBound(Tmp)
        If IsEmpty(Tmp(i, 1)) Then Exit For
        k = k + 1
        Cells(k + 4, 1) = k: Cells(k + 4, 2) = Tmp(i, 1): Cells(k + 4, 3) = Tmp(i, 3): Cells(k + 4, 4) = Tmp(i, 5): Cells(k + 4, 5) = Tmp(i, 7): Cells(k + 4, 8) = Tmp(i, 12): Cells(k + 4, 11) = Tmp(i, 10)
    Next
    Tmp = Sheets("2").[E5:M500]
    For i = 1 To UBound(Tmp)
        If IsEmpty(Tmp(i, 1)) Then Exit For
        k = k + 1
        Cells(k + 4, 1) = k: Cells(k + 4, 2) = Tmp(i, 1): Cells(k + 4, 3) = Tmp(i, 3): Cells(k + 4, 4) = Tmp(i, 5): Cells(k + 4, 5) = Tmp(i, 9): Cells(k + 4, 8) = Tmp(i, 2)
    Next
    Tmp = Sheets("3").[C5:K500]
    For i = 1 To UBound(Tmp)
        If IsEmpty(Tmp(i, 1)) Then Exit For
        k = k + 1
        Cells(k + 4, 1) = k: Cells(k + 4, 2) = Tmp(i, 1): Cells(k + 4, 3) = Tmp(i, 5): Cells(k + 4, 4) = Tmp(i, 7): Cells(k + 4, 5) = Tmp(i, 9): Cells(k + 4, 8) = Tmp(i, 3)
    Next
        With .[A5].Resize(k, 12)
            .Font.Name = "Courier New"
            .Font.Size = 10
        End With
        With .[F5].Resize(k)
            .NumberFormat = "#,##0"
            .Font.Size = 14
            .Font.Bold = True
            .Font.ColorIndex = 3
        End With
        With .[B5:D5].Resize(k)
            .Font.Size = 10
            .Font.ColorIndex = 1
        End With
        .[A4].Resize(k + 1, 11).Borders.LineStyle = 1
    End With
    Application.ScreenUpdating = True
End Sub

 

[ndu96081631]

[h=2]Điều Chỉnh Code[/h]

Muốn "điều chỉnh" gì gì đó thì hãy vào đây:
www.giaiphapexcel.com/forum/showthread.php?83698-Chuyên-đề-giải-đáp-những-thắc-mắc-về-code-VBA
Còn không thì cố nghĩ ra cái tiêu đề khác đi