Sửa dùm code (1 người xem)

Elx Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Nguoiay

Nguoiay

Thành viên hoạt động
Tham gia
24/11/10
Bài viết
139
Được thích
34
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.
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
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.
Nhấp chuột vào đây để mở rộng...
-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
 
Lần chỉnh sửa cuối:
Upvote 0
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?
 
Upvote 0
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ấp chuột vào đây để mở rộng...

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.
 
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...

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.
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...

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..!!
 
Upvote 0
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..!!
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...

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..!!
Nhấp chuột vào đây để mở rộng...

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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...

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?
 
Lần chỉnh sửa cuối:
Upvote 0
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?
Nhấp chuột vào đây để mở rộng...
-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
Nhấp chuột vào đây để mở rộng...
-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
 
Upvote 0
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?
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...

Vâng, con cũng đã test rùi...chú! Cám ơn chú nhiều!!
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

Emyeuexcel
Tham chiếu về 1 ô-lấy ra và lọc dữ liệu (5 người xem)
Trả lời
5
Đọc
83
Emyeuexcel
Emyeuexcel
L
Hỏi lỗi excel bị tràn trang khi in (1 người xem)
Trả lời
3
Đọc
60
Hoàng Tuấn 868
H
C
Fix lỗi Application.InputBox Type:=8 (2 người xem)
    • Cười
Trả lời
5
Đọc
89
cdshtz88
C
E
  • Question Question
VBA tự động thay đổi tham chiếu vùng (range và cell) khi insert dòng cột trong sheet tính toán (1 người xem)
    • Cười
Trả lời
5
Đọc
118
eagle12
E
D
Tổng hợp dữ liệu từ các sheet sang sheet tổng (1 người xem)
Trả lời
3
Đọc
143
dohungmo
D
T
font chu trong excel (2 người xem)
Trả lời
2
Đọc
69
Hoàng Tuấn 868
H
khuong182018
  • Question Question
Nhờ anh chị sửa lỗi setfocus ở textbox (1 người xem)
Trả lời
9
Đọc
163
khuong182018
khuong182018
N
File chia băng tự động từ cuộn mẹ theo khổ băng và khối lượng băng cho trước (1 người xem)
Trả lời
0
Đọc
42
nguyenanhtruong2409
N
SA_DQ
Copilot bình luận về một ván cờ vua
Trả lời
0
Đọc
72
SA_DQ
SA_DQ
T
Xin giúp đỡ lọc dữ liệu
    • Cười
Trả lời
4
Đọc
111
pycckuu410
pycckuu410
Nguyễn Duy Tuân
[New] BSAC v3.0 bộ công cụ lập trình phần mềm chuyên nghiệp trong VBA (1 người xem)
    • Thích
Trả lời
13
Đọc
4K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
H
  • Question Question
Code Sổ Chi Tiết Tài Khoản
Trả lời
8
Đọc
324
hieuvietmy2020
H
befaint
Chia sẻ tâm tư, xả nỗi lòng (5 người xem)
    • Thích
6 7 8
Trả lời
778
Đọc
75K
SA_DQ
SA_DQ
H
Chia sẻ file in Phiếu điều tra PCGD
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
12
Đọc
441
HUONGHCKT
H
V
Hỏi công thức để làm khối lượng trong xây dựng. Xin cảm ơn
Trả lời
11
Đọc
522
phanphu_91
P
Linhnv0001
Hỏi - Cách kiểm tra laptop là hàng lắp ráp hay không (2 người xem)
Trả lời
3
Đọc
275
Lê Duy Thương
Lê Duy Thương
K
Nhờ anh chị làm công thức lọc dữ kiện ngày từ bảng 1 sang rút gọn ngày ở bảng 2.
Trả lời
2
Đọc
186
Lê Duy Thương
Lê Duy Thương
L
[Mẹo] Không chọn Add-in vẫn có thể sử dụng được chức năng của Add-in, giảm tốc độ loading của Excel.
    • Thích
Trả lời
2
Đọc
496
HeSanbi
HeSanbi
GPE-Trợ Lý
[GPE18] KỸ THUẬT BIỂU ĐỒ NÂNG CAO CHO DASHBOARD: TRỰC QUAN HÓA TIẾN ĐỘ THỰC HIỆN KẾ HOẠCH
    • Thích
Trả lời
2
Đọc
9K
ptm0412
ptm0412
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (8 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
4 5 6
Trả lời
553
Đọc
72K
anh.nguyen287
anh.nguyen287
Xem thêm…

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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom