Nhờ GPE Viết dùm em đoạn code xóa dòng như sau (1 người xem)

[pham van an]

Nhờ GPE Viết dùm em đoạn cos xóa dòng như sau.
đây là bài toán của nghành kỹ thuật, nên mục đích có thể hơi lạ với nhiều bác, mong thông cảm.

 

[Quang_Hải]

Nhờ GPE Viết dùm em đoạn cos xóa dòng như sau.
đây là bài toán của nghành kỹ thuật, nên mục đích có thể hơi lạ với nhiều bác, mong thông cảm.

Thử đoạn code này xem coi thế nào

Private Sub CommandButton1_Click()
Dim dl, i, j, kq, k, n
dl = Range([a4], [a65536].End(3)).Resize(, 12)
ReDim kq(1 To UBound(dl), 1 To 12)
For i = 1 To UBound(dl) - 1
  If dl(i, 2) = dl(i + 1, 2) Then
    If dl(i, 3) = dl(i + 1, 3) Then
      If dl(i, 6) >= dl(i + 1, 6) Then
        k = k + 1
        For n = 1 To 12
          kq(k, n) = dl(i, n)
        Next
        i = i + 1
      Else
        k = k + 1
        For n = 1 To 12
          kq(k, n) = dl(i + 1, n)
        Next
        i = i + 1
      End If
    End If
  Else
    k = k + 1
    For n = 1 To 12
      kq(k, n) = dl(i, n)
    Next
  End If
Next
[a4].Resize(i, 12) = kq
End Sub

 

[pham van an]

Nhờ anh xem lại dùm em. khi xóa thì dòng cuối cùng cũng bị xóa luôn rồi

 

[Ba Tê]

Nhờ anh xem lại dùm em. khi xóa thì dòng cuối cùng cũng bị xóa luôn rồi

Thấy cái vụ trùng này sao tôi hay bị "Đíc" quá.
Thử code này cho cái nút đó coi:

Private Sub CommandButton1_Click()
Dim Rng(), Arr(), Dic As Object, I As Long, J As Long, K As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
Rng = Range([A4], [A65000].End(xlUp)).Resize(, 12).Value
ReDim Arr(1 To UBound(Rng, 1), 1 To 12)
    For I = 1 To UBound(Rng, 1)
        Tem = Rng(I, 2) & Rng(I, 3)
        If Not Dic.Exists(Tem) Then
            K = K + 1: Dic.Add Tem, K
            For J = 1 To 12
                Arr(K, J) = Rng(I, J)
            Next J
        Else
            If Abs(Rng(I, 6)) > Abs(Arr(Dic.Item(Tem), 6)) Then
                Arr(Dic.Item(Tem), 6) = Rng(I, 6)
            End If
        End If
    Next I
[A4:L10000].ClearContents
[A4].Resize(K, 12).Value = Arr
Set Dic = Nothing
End Sub

 

[pham van an]

không được rồi, anh xóa mất bao nhiêu dòng của em.

 

[Quang_Hải]

Nhờ anh xem lại dùm em. khi xóa thì dòng cuối cùng cũng bị xóa luôn rồi

Sửa code lại tí là được

Private Sub CommandButton1_Click()
On Error Resume Next
Dim dl, i, j, kq, k, n
dl = Range([a4], [a65536].End(3)).Resize(, 12)
ReDim kq(1 To UBound(dl), 1 To 12)
For i = 1 To UBound(dl)
  If dl(i, 2) = dl(i + 1, 2) Then
    If dl(i, 3) = dl(i + 1, 3) Then
      If dl(i, 6) >= dl(i + 1, 6) Then
        k = k + 1
        For n = 1 To 12
          kq(k, n) = dl(i, n)
        Next
        i = i + 1
      Else
        k = k + 1
        For n = 1 To 12
          kq(k, n) = dl(i + 1, n)
        Next
        i = i + 1
      End If
    End If
  Else
    k = k + 1
    For n = 1 To 12
      kq(k, n) = dl(i, n)
    Next
  End If
Next
[a4:l10000].ClearContents
[a4].Resize(k, 12) = kq
End Sub

 

[Quang_Hải]

Thấy cái vụ trùng này sao tôi hay bị "Đíc" quá.
Thử code này cho cái nút đó coi:

Private Sub CommandButton1_Click()
Dim Rng(), Arr(), Dic As Object, I As Long, J As Long, K As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
Rng = Range([A4], [A65000].End(xlUp)).Resize(, 12).Value
ReDim Arr(1 To UBound(Rng, 1), 1 To 12)
    For I = 1 To UBound(Rng, 1)
        Tem = Rng(I, 2) & Rng(I, 3)
        If Not Dic.Exists(Tem) Then
            K = K + 1: Dic.Add Tem, K
            For J = 1 To 12
                Arr(K, J) = Rng(I, J)
            Next J
        Else
            If Abs(Rng(I, 6)) > Abs(Arr(Dic.Item(Tem), 6)) Then
                Arr(Dic.Item(Tem), 6) = Rng(I, 6)
            End If
        End If
    Next I
[A4:L10000].ClearContents
[A4].Resize(K, 12).Value = Arr
Set Dic = Nothing
End Sub

Anh ơi hình như thiếu thiếu tí gì đó, em cảm giác thế.

 

[vodoi2x]

Sửa code lại tí là được

Private Sub CommandButton1_Click()
On Error Resume Next
Dim dl, i, j, kq, k, n
dl = Range([a4], [a65536].End(3)).Resize(, 12)
ReDim kq(1 To UBound(dl), 1 To 12)
For i = 1 To UBound(dl)
  If dl(i, 2) = dl(i + 1, 2) Then
    If dl(i, 3) = dl(i + 1, 3) Then
      If dl(i, 6) >= dl(i + 1, 6) Then
        k = k + 1
        For n = 1 To 12
          kq(k, n) = dl(i, n)
        Next
        i = i + 1
      Else
        k = k + 1
        For n = 1 To 12
          kq(k, n) = dl(i + 1, n)
        Next
        i = i + 1
      End If
    End If
  Else
    k = k + 1
    For n = 1 To 12
      kq(k, n) = dl(i, n)
    Next
  End If
Next
[a4:l10000].ClearContents
[a4].Resize(k, 12) = kq
End Sub

pac QuangHai tích cực quá, CN nghỉ ngơi đi, hihihi

Bài này sao không xoá dòng đơn giản pac, sao phải Array dài dòng vậy?

--------------
Hỏi Chủ Topic? cột B đã được sắp xếp theo giá trị ah? để các giá trị = nhau ở gần nhau (dĩ nhiên sắp xếp theo column C và đến giá trị tại column B)????

 

[ndu96081631]

Sửa code lại tí là được

Viết code phải tính ở mức tổng quát. Đặt trường hợp dữ liệu không sắp xếp trước thì code này coi như.. tèo
Dùng Dictionary như Ba Tê tôi nghĩ là chuẩn nhất ---> Dữ liệu có sort hay không chẳng ảnh hưởng gì
Chỉ là trong code của Ba Tê có đoạn:

Tem = Rng(I, 2) & Rng(I, 3)

Nếu cẩn thận hơn (cho dữ liệu dạng tổng quát) thì nên là

Tem = Rng(I, 2) & "Một ký tự đặc biệt nào đó" & Rng(I, 3)

Ngoài ra cũng nên xét đến trường hợp dữ liệu rổng nữa ---> Tôi có thói quen khi viết code định vị vùng dữ liệu cứ "quất" cha nó cở vài chục ngàn dòng rồi chạy (không cần End(xlUp)...)... gặp dữ liệu rổng thì bỏ qua ---> Như vậy dữ liệu rổng nằm bên trong dữ liệu cũng sẽ được bỏ qua luôn
Ẹc... Ẹc...

 

[Ba Tê]

Viết code phải tính ở mức tổng quát. Đặt trường hợp dữ liệu không sắp xếp trước thì code này coi như.. tèo
Dùng Dictionary như Ba Tê tôi nghĩ là chuẩn nhất ---> Dữ liệu có sort hay không chẳng ảnh hưởng gì
Chỉ là trong code của Ba Tê có đoạn:

Tem = Rng(I, 2) & Rng(I, 3)

Nếu cẩn thận hơn (cho dữ liệu dạng tổng quát) thì nên là

Tem = Rng(I, 2) & "Một ký tự đặc biệt nào đó" & Rng(I, 3)

Ngoài ra cũng nên xét đến trường hợp dữ liệu rổng nữa ---> Tôi có thói quen khi viết code định vị vùng dữ liệu cứ "quất" cha nó cở vài chục ngàn dòng rồi chạy (không cần End(xlUp)...)... gặp dữ liệu rổng thì bỏ qua ---> Như vậy dữ liệu rổng nằm bên trong dữ liệu cũng sẽ được bỏ qua luôn
Ẹc... Ẹc...

Chưa "bị" các lỗi như thế này nên cho hỏi ndu... một chút nhé:
1- Thêm "ký tự đặc biệt" có lợi gì tôi chưa hiểu, đàng nào cũng là dữ liệu ghép của 2 cột mà?
2- End(xlup) nó có bỏ qua dòng nào đâu, có chăng chỉ không có bỏ qua dòng rỗng trong mảng khi viết code thôi mà!
3- Cái "dzụ" trên tôi cũng chưa hiểu bị lỗi gì.
Hơi hơi hiểu:ABC & DEF bị lỗi khi AB & CDEF???
(Híc! (Mới "1 xị" dìa, hơi tối con mắt, Ẹc...)

 

[le tin]

1- Thêm "ký tự đặc biệt" có lợi gì tôi chưa hiểu, đàng nào cũng là dữ liệu ghép của 2 cột mà?

Ví dụ:

1/ Rng(I, 2)= ABC ; Rng(I, 3)= DE => Tem = ABCDE
2/ Rng(I, 2)= AB ; Rng(I, 3)= CDE => Tem = ABCDE
Nên thêm "Một ký tự đặc biệt nào đó" cho chắc ăn

 

[Ba Tê]

Ví dụ:

1/ Rng(I, 2)= ABC ; Rng(I, 3)= DE => Tem = ABCDE
2/ Rng(I, 2)= AB ; Rng(I, 3)= CDE => Tem = ABCDE
Nên thêm "Một ký tự đặc biệt nào đó" cho chắc ăn

Cái này thì tôi đã "ngộ ra" rồi:

Chưa "bị" các lỗi như thế này nên cho hỏi ndu... một chút nhé:

Hơi hơi hiểu:ABC & DEF bị lỗi khi AB & CDEF???

Nếu bạn hiểu thì giải thích thêm cái khác đi.

 

[ndu96081631]

2- End(xlup) nó có bỏ qua dòng nào đâu, có chăng chỉ không có bỏ qua dòng rỗng trong mảng khi viết code thôi mà!

Anh End(xlUp) cho cột A nhưng anh làm việc trên các cột khác mà ---> Ví dụ A10:A11 <> "" nhưng B10:B11 = "" và C10:C11 = "" thi tính sao?
Bởi vậy em mới nói không cần End(xlUp) vì lý do:
- Mảng có tốc độ rất cao, chênh lệch 10000 dòng cũng không khác nhau mấy về thời gian tính toán
- End(xlUp) mất công bị "dính chưởng" AutoFilter
- Thà rằng xét rổng ở điều kiện còn hay hơn
Ẹc... Ẹc...