Code xoá hàng theo điều kiện? (1 người xem)

[790312]

Nhờ các bác viết giùm đoạn code,nội dung mình ghi trong file đính kèm.Thanks.

 

[Quang_Hải]

Có thể nó nhiều hơn 4 bác ah,nhưng chỉ cần lấy thằng CUỐI chia cho 2 là được thằng GIỮA,Thằng ĐẦU thì lúc nào cũng là 0 rồi.Bài toán của e thì chỉ cần lấy thằng ĐẦU,GIỮA,CUỐI thôi.Thanks.

Xài thế này nha xem coi đúng chưa

Sub xoa_ky_cuc()
Dim d As Object, dl(), dk As String, key(), kq(), tam()
Dim i As Long, j As Long, k As Long, x As Byte, n As Double
Set d = CreateObject("scripting.dictionary")
dl = Range([a2], [a65536].End(3)).Resize(, 4).Value
[K2:N20000].ClearContents
ReDim tam(1 To UBound(dl), 1 To 4)
For i = 1 To UBound(dl)
    dk = dl(i, 1) & dl(i, 2)
    If Not d.exists(dk) Then d.Add dk, ""
Next
key = d.keys
For j = 0 To UBound(key)
    For i = 1 To UBound(dl)
        dk = dl(i, 1) & dl(i, 2)
        If dk = key(j) Then
            k = k + 1
            For x = 1 To 4
                tam(k, x) = dl(i, x)
            Next
        End If
    Next
    n = tam(k, 4):    k = 0
    ReDim kq(1 To UBound(tam), 1 To 4)
    For i = 1 To UBound(tam)
        If tam(i, 4) = 0 Or tam(i, 4) = n / 2 Or tam(i, 4) = n Then
            k = k + 1
            For x = 1 To 4
                kq(k, x) = tam(i, x)
            Next
        End If
    Next
    [k65536].End(3).Offset(1).Resize(k, 4) = kq
    k = 0
Next
End Sub

 

[viehoai]

Code chạy ra KQ sai rồi bác ơi.Bác test lại giùm e với.Thanks.

Bạn copy lại code giúp mình
Vì lúc đầu: Tmp1 = Sheet1.Range("D" & i - 1).Value
Sau đó đã sửa: Tmp = Sheet1.Range("D" & i - 1).Value

 

[concogia]

Có thể nó nhiều hơn 4 bác ah,nhưng chỉ cần lấy thằng CUỐI chia cho 2 là được thằng GIỮA,Thằng ĐẦU thì lúc nào cũng là 0 rồi.Bài toán của e thì chỉ cần lấy thằng ĐẦU,GIỮA,CUỐI thôi.Thanks.

Thử file này xem sao
Mình để kết quả từ cột [K] cho dễ kiểm tra nhé bạn
Thân

 

[Quang_Hải]

Xét thấy bài này cũng hay hay, nếu xoá dòng trực tiếp trên sheet mà gặp phải dữ liệu nhiều thì có lẽ sẽ chậm.
Nếu dùng mảng không biết các thành viên khác có code nào gọn gọn không. Mình nghĩ mãi cũng không làm cho code ngắn lại được

Sub xoa_dong()
Dim d As Object, dl(), key(), kq(), tam()
Dim i As Long, j As Integer, k As Long, kk As Long, x As Byte, n As Double
Set d = CreateObject("scripting.dictionary")
dl = Range([a2], [a65536].End(3)).Resize(, 4).Value
ReDim kq(1 To UBound(dl), 1 To 4)
For i = 1 To UBound(dl)
    If Not d.exists(dl(i, 1) & dl(i, 2)) Then d.Add dl(i, 1) & dl(i, 2), ""
Next
key = d.keys
For j = 0 To UBound(key)
   ReDim tam(1 To UBound(dl), 1 To 4)
    For i = 1 To UBound(dl)
        If dl(i, 1) & dl(i, 2) = key(j) Then
            k = k + 1
            For x = 1 To 4
                tam(k, x) = dl(i, x)
            Next
        End If
    Next
    n = tam(k, 4)
    For i = 1 To k
        If tam(i, 4) = 0 Or tam(i, 4) = n / 2 Or tam(i, 4) = n Then
            kk = kk + 1
            For x = 1 To 4
                kq(kk, x) = tam(i, x)
            Next
        End If
    Next
    k = 0
Next
[K2].Resize(kk, 4) = kq
End Sub

 

[viehoai]

Xét thấy bài này cũng hay hay, nếu xoá dòng trực tiếp trên sheet mà gặp phải dữ liệu nhiều thì có lẽ sẽ chậm.
Nếu dùng mảng không biết các thành viên khác có code nào gọn gọn không. Mình nghĩ mãi cũng không làm cho code ngắn lại được

Sub xoa_dong()
Dim d As Object, dl(), key(), kq(), tam()
Dim i As Long, j As Integer, k As Long, kk As Long, x As Byte, n As Double
Set d = CreateObject("scripting.dictionary")
dl = Range([a2], [a65536].End(3)).Resize(, 4).Value
ReDim kq(1 To UBound(dl), 1 To 4)
For i = 1 To UBound(dl)
    If Not d.exists(dl(i, 1) & dl(i, 2)) Then d.Add dl(i, 1) & dl(i, 2), ""
Next
key = d.keys
For j = 0 To UBound(key)
   ReDim tam(1 To UBound(dl), 1 To 4)
    For i = 1 To UBound(dl)
        If dl(i, 1) & dl(i, 2) = key(j) Then
            k = k + 1
            For x = 1 To 4
                tam(k, x) = dl(i, x)
            Next
        End If
    Next
    n = tam(k, 4)
    For i = 1 To k
        If tam(i, 4) = 0 Or tam(i, 4) = n / 2 Or tam(i, 4) = n Then
            kk = kk + 1
            For x = 1 To 4
                kq(kk, x) = tam(i, x)
            Next
        End If
    Next
    k = 0
Next
[K2].Resize(kk, 4) = kq
End Sub

Anh Test giúp xem code dưới đây có nhanh hay chậm hơn nhé

Sub xoa_dong_Kho_Hieu()
Dim Dic, Arr(), ArrKQ(), Tmp
Dim i As Long, j As Integer, k As Long
On Error Resume Next
Arr = Sheet1.Range("A2:D" & Sheet1.[a65536].End(3).Row).Value
ReDim ArrKQ(1 To UBound(Arr), 1 To 4)
For i = 1 To UBound(Arr)
    If Arr(i, 1) <> nhom Then
      nhom = Arr(i, 1)
      For j = i To i + 1000
        If Arr(j, 1) <> nhom Then
          Tmp = Arr(j - 1, 4)
          GoTo Tiep
        End If
      Next
    End If
Tiep:
    If Arr(i, 4) = 0 Or Arr(i, 4) = Tmp / 2 Or Arr(i, 4) = Tmp Then
      k = k + 1
      ArrKQ(k, 1) = Arr(i, 1)
      ArrKQ(k, 2) = Arr(i, 2)
      ArrKQ(k, 4) = Arr(i, 4)
    End If
Next
Sheet1.Range("J2").Resize(UBound(Arr), 4).Value = ArrKQ
End Sub

Cái này không dùng Dic được anh quanghai ơi, vì anh để ý thấy bài 1 dữ liệu của tác giả có 2 nhóm T1
(Hic tác giả cho dữ liệu đôi lúc giống anh nghĩ nhưng vì nhác copy lại chẳng hay ẹc ẹc..)

 

[Quang_Hải]

Anh Test giúp xem code dưới đây có nhanh hay chậm hơn nhé

Sub xoa_dong_Kho_Hieu()
Dim Dic, Arr(), ArrKQ(), Tmp
Dim i As Long, j As Integer, k As Long
On Error Resume Next
Arr = Sheet1.Range("A2:D" & Sheet1.[a65536].End(3).Row).Value
ReDim ArrKQ(1 To UBound(Arr), 1 To 4)
For i = 1 To UBound(Arr)
    If Arr(i, 1) <> nhom Then
      nhom = Arr(i, 1)
      For j = i To i + 1000
        If Arr(j, 1) <> nhom Then
          Tmp = Arr(j - 1, 4)
          GoTo Tiep
        End If
      Next
    End If
Tiep:
    If Arr(i, 4) = 0 Or Arr(i, 4) = Tmp / 2 Or Arr(i, 4) = Tmp Then
      k = k + 1
      ArrKQ(k, 1) = Arr(i, 1)
      ArrKQ(k, 2) = Arr(i, 2)
      ArrKQ(k, 4) = Arr(i, 4)
    End If
Next
Sheet1.Range("J2").Resize(UBound(Arr), 4).Value = ArrKQ
End Sub

Cái này không dùng Dic được anh quanghai ơi, vì anh để ý thấy bài 1 dữ liệu của tác giả có 2 nhóm T1
(Hic tác giả cho dữ liệu đôi lúc giống anh nghĩ nhưng vì nhác copy lại chẳng hay ẹc ẹc..)

Mình tính test thử thuật toán nhưng không biết biến nhom là gì, vừa chạy code thì báo lỗi chỗ đó.
Mình dùng dic để add cột 1 và 2 lại được mà

 

[viehoai]

Mình tính test thử thuật toán nhưng không biết biến nhom là gì, vừa chạy code thì báo lỗi chỗ đó.
Mình dùng dic để add cột 1 và 2 lại được mà

Nhom là xác định nhóm T1, T2. Em chạy đâu có lỗi nhỉ
Em lợi thế hơn anh 1 vòng lặp nhưng không biết ăn thua gì không

 

[Quang_Hải]

Nhom là xác định nhóm T1, T2. Em chạy đâu có lỗi nhỉ
Em lợi thế hơn anh 1 vòng lặp nhưng không biết ăn thua gì không

Về tốc độ thì code của VietHoai nhanh hơn code của mình tí, nhưng kết quả 2 code ra không khớp với nhau, hỏng biết code nào trúng nữa. Vả lại không có đủ dữ liệu nên khó test quá... Nhưng mình cũng hài lòng rồi.