Code copy dữ liệu có điều kiện (1 người xem)

[BoKuDo]

Đoạn code trong file đính kèm mình gửi lên copy được dữ liệu từ sheet Data sang sheet Input. Nay mình nhờ các bạn giúp thêm phần điều kiện để copy, nghĩa là chỉ copy những dòng có cột đánh giá từ 5 (>=5) trở lên thôi, các dòng có cột đánh giá dưới 5 (<5) sẽ không được copy qua sheet Input. Còn thứ tự các dòng thì vẫn giữ như bên sheet Data.

Đoạn code mình cần các bạn giúp

Sub Copy()
Dim endR As Integer
With ActiveWorkbook.ActiveSheet
    endR = .Range("C65000").End(xlUp).Row
    ThisWorkbook.Sheets("Input").Select
    Union(.Range("C7:C" & endR), .Range("I7:I" & endR), .Range("M7:M" & endR)).Copy [C9]
    .Range("J7:J" & endR).Copy: [f9].PasteSpecial 3
    .Range("J3").Copy: Range("F9:F" & [F65000].End(xlUp).Row).PasteSpecial 1, xlDivide
    Range("B9:B" & [C65000].End(xlUp).Row).FormulaR1C1 = "=ROW()-8"
End With
End Sub

Mình cảm ơn.

 

[BoKuDo]

up nhờ các bạn giúp.

 

[BoKuDo]

up nhờ các bạn giúp.

 

[lhthai]

Đoạn code trong file đính kèm mình gửi lên copy được dữ liệu từ sheet Data sang sheet Input. Nay mình nhờ các bạn giúp thêm phần điều kiện để copy, nghĩa là chỉ copy những dòng có cột đánh giá từ 5 (>=5) trở lên thôi, các dòng có cột đánh giá dưới 5 (<5) sẽ không được copy qua sheet Input. Còn thứ tự các dòng thì vẫn giữ như bên sheet Data.

Đoạn code mình cần các bạn giúp

Sub Copy()
Dim endR As Integer
With ActiveWorkbook.ActiveSheet
    endR = .Range("C65000").End(xlUp).Row
    ThisWorkbook.Sheets("Input").Select
    Union(.Range("C7:C" & endR), .Range("I7:I" & endR), .Range("M7:M" & endR)).Copy [C9]
    .Range("J7:J" & endR).Copy: [f9].PasteSpecial 3
    .Range("J3").Copy: Range("F9:F" & [F65000].End(xlUp).Row).PasteSpecial 1, xlDivide
    Range("B9:B" & [C65000].End(xlUp).Row).FormulaR1C1 = "=ROW()-8"
End With
End Sub

Mình cảm ơn.

Làm thử không biết đúng ý không nha

Sub Copy()
Dim Arr(), Darr(1 To 65536, 1 To 5), i, j, k
With Sheet1
Arr = .Range("C7", .[C65000].End(xlUp)).Resize(, 16).Value
End With
For i = 1 To UBound(Arr, 1)
If Arr(i, 7) >= 5 Then
k = k + 1
Darr(k, 1) = k
Darr(k, 2) = Arr(i, 1)
Darr(k, 3) = Arr(i, 7)
Darr(k, 4) = Arr(i, 11)
Darr(k, 5) = Arr(i, 9) / 1000
End If
Next
With Sheet4
.Range("B9:F5000").ClearContents
.Range("B9").Resize(k, 5) = Darr
End With
End Sub

 

[BoKuDo]

Cảm ơn bạn lhthai đã giúp!
Code làm việc vậy là đúng ý mình rồi

 

[phihndhsp]

chào bạn, code của bạn rất là tuyệt. nó quả là sẽ giúp mình rất nhiều. nhưng không biết bạn có thể giải thích cho mình bằng lời được không ạ?
rất hi vọng vào lời giải thích của bạn. cảm ơn bạn nhiều.

vấn đề ở đây không phải code kiết gì cả, mà vấn đề ở đây là bạn đã biết mặt chữ VBA chưa? và bạn không hiểu chỗ nào?

 

[giangleloi]

vba =Visual basic applications. Mặt chữ mà. . Xin lỗi. Đùa bạn thôi. Cũng vừa tiếp xúc. Nên đi đọc hết các bài. Thấy cái của bạn rata hữu ích cho mình. :d. Cái mình ko hiểu ở đây, có 2 vấn đề: nếu ban nói cho mình dc thì cảm ơn nhiều
1: là mấy cái bạn khai báo arr, và darr ,ngoài ra còn có i,j,k mình ko biết là ko gán kiểu cho nó. Tóm lại là chưa hiẻu và biết cách khai báo kiểu đấy.
2: vì là ko hiểu nên cái phần trong câu lệnh if mình hoàn toàn ko cắt ngĩa được, nên mới nhờ bạn gt hộ ih mà.
Có gì ko phải bỏ qua nhé. .

Arr với Darr là mảng. Bạn kiếm bài viết về mảng để tự vọc cho "thấu" hơn nhé.