Sửa dùm code

Nguoiay · 29/11/10

AC sửa dùm em code này nhé:

PHP:

Sub Copy_dl()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim i As Long
    Set ws1 = Sheets("Data")
    Set ws2 = Sheets("KH")
    With ws2
    For i = 1 To 3
        If .Cells(1, 8) > 0 Or .Cells(i, 9) > 0 Then
            ws1.Cells(i, 1) = .Cells(i, 1).Value
            ws1.Cells(i, 2) = .Cells(i, 2).Value
            ws1.Cells(i, 3) = .Cells(i, 3).Value
            ws1.Cells(i, 4) = .Cells(i, 4).Value
            ws1.Cells(i, 5) = .Cells(i, 5).Value
            ws1.Cells(i, 6) = .Cells(i, 6).Value
            ws1.Cells(i, 7) = .Cells(i, 7).Value
            ws1.Cells(i, 8) = .Cells(i, 8).Value
            ws1.Cells(i, 9) = .Cells(i, 9).Value
            i = i + 1
        End If
    Next
    End With
End Sub

AC tham khao câu hỏi cụ thể trong file đính kèm nha.

keentwo · 29/11/10

Nguoiay đã viết:

AC sửa dùm em code này nhé:

PHP:

Sub Copy_dl()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim i As Long
    Set ws1 = Sheets("Data")
    Set ws2 = Sheets("KH")
    With ws2
    For i = 1 To 3
        If .Cells(1, 8) > 0 Or .Cells(i, 9) > 0 Then
            ws1.Cells(i, 1) = .Cells(i, 1).Value
            ws1.Cells(i, 2) = .Cells(i, 2).Value
            ws1.Cells(i, 3) = .Cells(i, 3).Value
            ws1.Cells(i, 4) = .Cells(i, 4).Value
            ws1.Cells(i, 5) = .Cells(i, 5).Value
            ws1.Cells(i, 6) = .Cells(i, 6).Value
            ws1.Cells(i, 7) = .Cells(i, 7).Value
            ws1.Cells(i, 8) = .Cells(i, 8).Value
            ws1.Cells(i, 9) = .Cells(i, 9).Value
            i = i + 1
        End If
    Next
    End With
End Sub

AC tham khao câu hỏi cụ thể trong file đính kèm nha.

-Xem thế này đã đúng ý bạn chưa.Mà nên xoá các dữ liệu ở Sheet Data trước khi sao sang bạn ạ,không có lúc sẽ nhầm đó.

PHP:

Sub Copy_dl()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim i As Long, j As Integer, n As Integer
    Set ws1 = Sheets("Data")
    Set ws2 = Sheets("KH")
    'dem so o co dulieu VD den o hang 1000
    n = Application.WorksheetFunction.CountA(ws2.Range("A3:A1000"))
    j = 2
    Application.ScreenUpdating = False
    With ws2
    For i = 1 To n
        If .Cells(2 + i, 8) > 0 Or .Cells(2 + i, 9) > 0 Then
            ws1.Cells(j, 1) = .Cells(2 + i, 1).Value
            ws1.Cells(j, 2) = .Cells(2 + i, 2).Value
            ws1.Cells(j, 3) = .Cells(2 + i, 3).Value
            ws1.Cells(j, 4) = .Cells(2 + i, 4).Value
            ws1.Cells(j, 5) = .Cells(2 + i, 5).Value
            ws1.Cells(j, 6) = .Cells(2 + i, 6).Value
            ws1.Cells(j, 7) = .Cells(2 + i, 7).Value
            ws1.Cells(j, 8) = .Cells(2 + i, 8).Value
            ws1.Cells(j, 9) = .Cells(2 + i, 9).Value
            j = j + 1
        End If
    Next
    End With
    ws1.Select
    Application.ScreenUpdating = True
End Sub

ptm0412 · 29/11/10

1. Đoạn code này:

PHP:

If .Cells(2 + i, 8) > 0 Or .Cells(2 + i, 9) > 0 Then
            ws1.Cells(j, 1) = .Cells(2 + i, 1).Value
            ws1.Cells(j, 2) = .Cells(2 + i, 2).Value
            ws1.Cells(j, 3) = .Cells(2 + i, 3).Value
            ws1.Cells(j, 4) = .Cells(2 + i, 4).Value
            ws1.Cells(j, 5) = .Cells(2 + i, 5).Value
            ws1.Cells(j, 6) = .Cells(2 + i, 6).Value
            ws1.Cells(j, 7) = .Cells(2 + i, 7).Value
            ws1.Cells(j, 8) = .Cells(2 + i, 8).Value
            ws1.Cells(j, 9) = .Cells(2 + i, 9).Value
            j = j + 1
        End If

Sao không làm gọn lại:

PHP:

If .Cells(2 + i, 8) > 0 Or .Cells(2 + i, 9) > 0 Then
            ws1.Cells(j, 1).Resize(1, 9) = .Cells(2 + i, 1).Resize(1, 9).Value
            j = j + 1
        End If

2. Câu này:

PHP:

n = Application.WorksheetFunction.CountA(ws2.Range("A3:A1000"))

Sao không dùng phương thức End, từ đó, For i = 3 to n cho khỏe?

Nguoiay · 29/11/10

keentwo đã viết:

-Xem thế này đã đúng ý bạn chưa.Mà nên xoá các dữ liệu ở Sheet Data trước khi sao sang bạn ạ,không có lúc sẽ nhầm đó.

PHP:

Sub Copy_dl()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim i As Long, j As Integer, n As Integer
Set ws1 = Sheets("Data")
Set ws2 = Sheets("KH")
'dem so o co dulieu VD den o hang 1000
n = Application.WorksheetFunction.CountA(ws2.Range("A3:A1000"))
j = 2
Application.ScreenUpdating = False
With ws2
For i = 1 To n
If .Cells(2 + i, 8) > 0 Or .Cells(2 + i, 9) > 0 Then
ws1.Cells(j, 1) = .Cells(2 + i, 1).Value
ws1.Cells(j, 2) = .Cells(2 + i, 2).Value
ws1.Cells(j, 3) = .Cells(2 + i, 3).Value
ws1.Cells(j, 4) = .Cells(2 + i, 4).Value
ws1.Cells(j, 5) = .Cells(2 + i, 5).Value
ws1.Cells(j, 6) = .Cells(2 + i, 6).Value
ws1.Cells(j, 7) = .Cells(2 + i, 7).Value
ws1.Cells(j, 8) = .Cells(2 + i, 8).Value
ws1.Cells(j, 9) = .Cells(2 + i, 9).Value
j = j + 1
End If
Next
End With
ws1.Select
Application.ScreenUpdating = True
End Sub

Nhưng mình muốn mỗi lần chạy thủ tục thì nó sẽ tự động copy dữ liệu bên Sheet KH sang Sheet Data (nếu thoả mãn đk). Code hiện tại của bạn chỉ copy 1 lần thôi.

ptm0412 · 29/11/10

Nguoiay đã viết:
Nhưng mình muốn mỗi lần chạy thủ tục thì nó sẽ tự động copy dữ liệu bên Sheet KH sang Sheet Data (nếu thoả mãn đk). Code hiện tại của bạn chỉ copy 1 lần thôi.

Phải thay đổi dữ liệu, thêm bớt, ... rồi chạy thủ tục mới biết là chạy như thế nào chứ. Để nguyên vậy thì nhấn nút đến tết cũng không thấy thay đổi.

sealand · 29/11/10

1/Code của bạn viết sai rôi
2/Code của bạn có thể viết

Mã:

Sub Copy_dl()
Dim i
    For i = 3 To ThisWorkbook.Sheets("KH").[a65536].End(xlUp).Row
    If ThisWorkbook.Sheets("KH").Cells(i, 8) <> 0 Then _
    Worksheets("Data").[a65536].End(xlUp).Offset(1).Resize(, 9).Value = _
    Worksheets("KH").Cells(i, 1).Resize(, 9).Value
    Next
End Sub

3/Hiệu qua hơn dùng filter lọc sau đó chép

sealand · 29/11/10

Anh Mỹ à, trong trường hợp này không dùng Or được vì dùng or chẳng khác để nguyên vì lỗi tiền nợ, tiền có không bằng nhau vẫn lưu trong trường hợp này chắc "đinh" là

If .Cells(2 + i, 8) <> 0 And .Cells(2 + i, 9) -.Cells(2 + i, 8)= 0 Then

Nguoiay · 29/11/10

ptm0412 đã viết:
Phải thay đổi dữ liệu, thêm bớt, ... rồi chạy thủ tục mới biết là chạy như thế nào chứ. Để nguyên vậy thì nhấn nút đến tết cũng không thấy thay đổi.

Anh ơi, em đã sửa như thế này rùi:

PHP:

Sub Copy_dl()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim i As Long, j As Integer, eR As Long 'n As Integer
    Set ws1 = Sheets("Data")
    Set ws2 = Sheets("KH")
    'dem so o co dulieu VD den o hang 1000
    'n = Application.WorksheetFunction.CountA(ws2.Range("A3:A1000"))
    eR = ws2.Range("A65535").End(xlUp).Row + 1
    j = 2
    Application.ScreenUpdating = False
    With ws2
    For i = 1 To eR
        If .Cells(2 + i, 8) > 0 Or .Cells(2 + i, 9) > 0 Then
            ws1.Cells(j, 1).Resize(1, 9) = .Cells(2 + i, 1).Resize(1, 9).Value
            j = j + 1
        End If
    Next
    End With
    ws1.Select
    Set ws1 = Nothing
    Set ws2 = Nothing
    Application.ScreenUpdating = True
End Sub

Giờ em muốn mỗi lần chạy thủ tục thì nó lại cập nhật tiếp vào. Hiện tại nó chỉ cập nhập 1 lần thôi ah. Anh chỉ dùm thêm cho em nha..!!

concogia · 29/11/10

Nguoiay đã viết:
Anh ơi, em đã sửa như thế này rùi:

PHP:

Sub Copy_dl() ....... For i = 1 To eR If .Cells(2 + i, 8) > 0 Or .Cells(2 + i, 9) > 0 Then ws1.Cells(j, 1).Resize(1, 9) = .Cells(2 + i, 1).Resize(1, 9).Value j = j + 1 End If Next ..... End Sub

Giờ em muốn mỗi lần chạy thủ tục thì nó lại cập nhật tiếp vào. Hiện tại nó chỉ cập nhập 1 lần thôi ah. Anh chỉ dùm thêm cho em nha..!!

Thay thế chỗ vòng lặp For, bỏ luộn biến J

Mã:

For i = 1 To eR
        If .Cells(2 + i, 8) > 0 Or .Cells(2 + i, 9) > 0 Then
            ws1.Cells(5000, 1).End(xlUp)(2).Resize(1, 9) = .Cells(i + 2, 1).Resize(1, 9).Value
        End If
    Next

Nguoiay · 29/11/10

Em đã sửa thế này chạy cũng ổn:

PHP:

Sub Copy_dl()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim i As Long, j As Long
    Set ws1 = Sheets("Data")
    Set ws2 = Sheets("KH")
    j = ws1.Range("A65535").End(xlUp).Row + 1
    Application.ScreenUpdating = False
    With ws2
    For i = 1 To 5
        If .Cells(2 + i, 8) <> 0 And .Cells(2 + i, 9) - .Cells(2 + i, 8) = 0 Then
            ws1.Cells(j, 1).Resize(1, 9) = .Cells(2 + i, 1).Resize(1, 9).Value
            j = j + 1
        End If
    Next
    End With
    ws1.Select
    Set ws1 = Nothing
    Set ws2 = Nothing
    Application.ScreenUpdating = True
End Sub

ptm0412 · 29/11/10

sealand đã viết:
Anh Mỹ à, trong trường hợp này không dùng Or được vì dùng or chẳng khác để nguyên vì lỗi tiền nợ, tiền có không bằng nhau vẫn lưu trong trường hợp này chắc "đinh" là

If .Cells(2 + i, 8) <> 0 And .Cells(2 + i, 9) -.Cells(2 + i, 8)= 0 Then

Mình sơ ý không đọc điều kiện, chỉ thấy 9 dòng và muốn rút lại 1 dòng thôi.

Lỗi tiền nợ khác tiền có, hoặc 1 trong 2 bằng 0 là lỗi nhập liệu, không phải lỗi code. Do đó chỉ cần 1 trong 2 <> 0. Nếu do lỗi nhập liệu sai mà không copy qua thì e rằng có người đếm thấy thiếu và tưởng code lỗi.

nguoiay đã viết:
Giờ em muốn mỗi lần chạy thủ tục thì nó lại cập nhật tiếp vào. Hiện tại nó chỉ cập nhập 1 lần thôi ah. Anh chỉ dùm thêm cho em nha..!!

Khi dữ liệu có thay đổi thêm bớt thì nhấn nút 1 phát bảo đảm sẽ cập nhật. Chỉ ngại rằng quên nhấn thôi. Còn code thì dùng code anh sealand cho khỏe và gọn:

Đã end(xlUp) thì không cần CountA
Đã dùng eR thì không cần tới n

Nguoiay · 29/11/10

concogia đã viết:
Thay thế chỗ vòng lặp For, bỏ luộn biến J

Mã:

For i = 1 To eR If .Cells(2 + i, 8) > 0 Or .Cells(2 + i, 9) > 0 Then ws1.Cells(5000, 1).End(xlUp)(2).Resize(1, 9) = .Cells(i + 2, 1).Resize(1, 9).Value End If Next

Trong đoạn code này em không hiểu (2) có ý nghĩa thế nào? Có phải dòng thứ 2?

keentwo · 30/11/10

ptm0412 đã viết:
]Sao không làm gọn lại:

PHP:

If .Cells(2 + i, 8) > 0 Or .Cells(2 + i, 9) > 0 Then ws1.Cells(j, 1).Resize(1, 9) = .Cells(2 + i, 1).Resize(1, 9).Value j = j + 1 End If

2. Câu này:

PHP:

n = Application.WorksheetFunction.CountA(ws2.Range("A3:A1000"))

Sao không dùng phương thức End, từ đó, For i = 3 to n cho khỏe?

-Cháu cám ơn bác. Thế mà không sực nhớ ra, lâu lâu không dùng lại quên quên rùi.Thank bác lần nữa.

concogia đã viết:
Thay thế chỗ vòng lặp For, bỏ luộn biến J

Mã:

For i = 1 To eR If .Cells(2 + i, 8) > 0 Or .Cells(2 + i, 9) > 0 Then ws1.Cells(5000, 1).End(xlUp)(2).Resize(1, 9) = .Cells(i + 2, 1).Resize(1, 9).Value End If Next

-Cháu thấy rất hay. Mà cũng rất đơn giản, đều là cơ bản mà lại rút ngắn code

concogia · 30/11/10

Nguoiay đã viết:
Trong đoạn code này em không hiểu (2) có ý nghĩa thế nào? Có phải dòng thứ 2?

Chính xác phải ghi (2,1)
Cứ thay thế các số, thí dụ: (3,1), (2,2) (0,1)..... rồi xem nó chạy lung tung đi chỗ nào sẽ hiểu thôi mà.
Làm như thế sẽ nhớ rất lâu chứ mình giải thích có khi ngủ dậy bạn quên mất tiêu. Híc
Thân

Nguoiay · 30/11/10

concogia đã viết:
Chính xác phải ghi (2,1)
Cứ thay thế các số, thí dụ: (3,1), (2,2) (0,1)..... rồi xem nó chạy lung tung đi chỗ nào sẽ hiểu thôi mà.
Làm như thế sẽ nhớ rất lâu chứ mình giải thích có khi ngủ dậy bạn quên mất tiêu. Híc
Thân

Vâng, con cũng đã test rùi...chú! Cám ơn chú nhiều!!

Sửa dùm code

Nguoiay

Thành viên hoạt động

File đính kèm

keentwo

Thành viên thường trực

ptm0412

Bad Excel Member

Nguoiay

Thành viên hoạt động

ptm0412

Bad Excel Member

sealand

Thành viên gạo cội

sealand

Thành viên gạo cội

Nguoiay

Thành viên hoạt động

concogia

Gội rồi mới Cạo

Nguoiay

Thành viên hoạt động

ptm0412

Bad Excel Member

Nguoiay

Thành viên hoạt động

keentwo

Thành viên thường trực

concogia

Gội rồi mới Cạo

Nguoiay

Thành viên hoạt động

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian