Tìm Code rà soát ký tự & đưa ra thông báo thiếu đủ & Copy Paste

[hoahuongduong1986]

Dear Các anh chị và các bạn của GPE,

Từ File Excel kèm theo em muốn tạo một Code làm việc như sau: (Nút bấm tại Sheet Baocao)

• Tại Sheet “Data” nó dò tìm toàn bộ dữ liệu vùng cột H, ô nào chứa cụm từ “Cần nhập mã” sau đó nó đưa ra Message như sau:
• + Nếu không có cụm từ này thì báo “Mã đã đủ” và sau đó bấm OK thì nó vào ô A1 của Sheet “Baocao”
• + Nếu có cụm từ này thì báo là “Chưa nhập đủ mã” và bấm vào OK thì nó vào Sheet “Ma” và Copy giá trị tại Cột C tương ứng với dòng “Cần nhập mã” tại Sheet Data và Paste vào từ ô D4 trở đi ạ tại Sheet Ma ạ. Nhờ các Anh chị và các bạn trợ giúp với ạ. Em cảm ơn Anh chị và các bạn ạ.

 

[leonguyenz]

Nên xử lý trên mảng đối với dữ liệu lớn, chứ trên Range cho vòng lặp hơn 13k dòng cũng mệt.
Tham khảo code:

Sub Button1_Click()
Dim sArr(), reArr(), i As Long, j As Long, k As String
k = Sheet3.Range("E1").Value
sArr = Sheet2.Range("C2:H" & Sheet2.Range("C65535").End(xlUp).Row).Value
ReDim reArr(1 To UBound(sArr, 1), 1 To 1)
For i = 1 To UBound(sArr, 1)
    If sArr(i, 6) = k Then
        j = j + 1
        reArr(j, 1) = sArr(i, 1)
    End If
Next i
If j Then
    Sheet3.Range("D4").Resize(j) = reArr
Else
    MsgBox "Ma da du"
    'Range("A1").Select
End If
End Sub

 

[hoahuongduong1986]

Nên xử lý trên mảng đối với dữ liệu lớn, chứ trên Range cho vòng lặp hơn 13k dòng cũng mệt.
Tham khảo code:

Sub Button1_Click()
Dim sArr(), reArr(), i As Long, j As Long, k As String
k = Sheet3.Range("E1").Value
sArr = Sheet2.Range("C2:H" & Sheet2.Range("C65535").End(xlUp).Row).Value
ReDim reArr(1 To UBound(sArr, 1), 1 To 1)
For i = 1 To UBound(sArr, 1)
    If sArr(i, 6) = k Then
        j = j + 1
        reArr(j, 1) = sArr(i, 1)
    End If
Next i
If j Then
    Sheet3.Range("D4").Resize(j) = reArr
Else
    MsgBox "Ma da du"
    'Range("A1").Select
End If
End Sub

Em cảm ơn anh ạ !

 

[concogia]

Nên xử lý trên mảng đối với dữ liệu lớn, chứ trên Range cho vòng lặp hơn 13k dòng cũng mệt.
Tham khảo code:

Sub Button1_Click()
Dim sArr(), reArr(), i As Long, j As Long, k As String
k = Sheet3.Range("E1").Value
sArr = Sheet2.Range("C2:H" & Sheet2.Range("C65535").End(xlUp).Row).Value
ReDim reArr(1 To UBound(sArr, 1), 1 To 1)
For i = 1 To UBound(sArr, 1)
    If sArr(i, 6) = k Then
        j = j + 1
        reArr(j, 1) = sArr(i, 1)
    End If
Next i
If j Then
    Sheet3.Range("D4").Resize(j) = reArr
Else
    MsgBox "Ma da du"
    'Range("A1").Select
End If
End Sub

Bài này nếu mình làm thì mình sẽ thêm 1 biến ( thí du A), đếm trong cột [H] có bao nhiêu cell thỏa điều kiện "Cần nhập mã"
1) Nếu may mắn nhất là không có em nào thỏa thì ........khỏi chạy, đỡ mệt
2) Nếu may mắn ít hơn tý, thí dụ như trong bài là 4 cell thỏa, nếu may mắn, mấy "thằng" này nằm ở 200 cell đầu thì chạy tới đó, đếm kết quả, nếu nó đủ với biến A thì.....thoát luôn, khỏi chạy mười mấy ngàn em sau, đỡ mệt. Híc
Thân