Code xoá hàng theo điều kiện? (1 người xem)
- Thread starter 790312
- Ngày gửi
Người dùng đang xem chủ đề này
khunglongcodon
Thành viên thường trực
- Tham gia
- 24/11/06
- Bài viết
- 222
- Được thích
- 100
- Nghề nghiệp
- Kế toán
Không hiểu điều kiện xóa của bạn lắm????
Upvote
0
Những hàng có giá trị cột A và B giống nhau sẽ khoanh vùng xoá hàng mà giá trị bên cột D không nằm trong khoảng ĐẦU,GIỮA,CUỐI.Thí dụ bên cột D giá trị các hàng là:
0
0
0
0,697
0,697
0,697
1,825
1,825
1,825
3,65
3,65
3,65
Thì nó sẽ xoá các hàng có giá trị là 0,697 vì khoảng đầu là 0,khoảng giữa là 1,825,khoảng cuối là 3,65.Còn các hàng có đầu,giữa,cuối rồi thì không xoá.Như:
0
0
1,725
1,725
3,45
3,45
Xoá hàng phụ thuộc và cột A và B như đã nói ở trên.
Thanks.
Lần chỉnh sửa cuối:
Upvote
0
Đúng rồi bác ah,nhưng từ hàng 92 nó có ĐẦU,GIỮA,CUỐI thì giữ nguyên bác ah.Code của bác là nó lại xoá mất khúc GIỮA.Nhờ bác xem lại giúp.Thanks.
Upvote
0
viehoai
Thành viên gắn bó
- Tham gia
- 22/5/09
- Bài viết
- 2,599
- Được thích
- 2,908
Bạn test code này thử xem sao nhé
Mã:
Sub DeleteRowsPA2()Dim Arr(), ArrKQ(), Tmp1, Tmp2
Dim i As Long, j As Long
'On Error Resume Next
ReDim ArrKQ(1 To UBound(Arr), 1 To 4)
Application.ScreenUpdating = False
Tmp1 = 0
Tmp2 = 0
For i = Sheet1.[a65500].End(3).Row + 1 To 2 Step -1
If Sheet1.Range("D" & i).Value = 0 And Sheet1.Range("D" & i - 1).Value > 0 Then
Tmp1 = Sheet1.Range("D" & i - 1).Value
End If
If Sheet1.Range("D" & i).Value = Tmp1 And Sheet1.Range("D" & i - 1).Value > 0 Then
Tmp2 = Sheet1.Range("D" & i - 1).Value
End If
If Sheet1.Range("D" & i).Value > 0 And Sheet1.Range("D" & i).Value <> Tmp1 And Sheet1.Range("D" & i).Value <> Tmp2 Then
Sheet1.Range("D" & i).EntireRow.Delete
End If
Next
Application.ScreenUpdating = True
End Sub
Upvote
0
Bác test lại code giùm e,sao nó không chạy được?
Upvote
0
File này thì chạy tốt nhưng khi e đổi số liệu khác là nó chạy không đúng bác ạ.Bác xem giúp e.Thanks.
Upvote
0
Đây bác ah.KQ là cột bôi đỏ.
Upvote
0
Quang_Hải
Thành viên gạo cội
- Tham gia
- 21/2/09
- Bài viết
- 6,074
- Được thích
- 8,005
- Nghề nghiệp
- Làm đủ thứ
Bạn xem lại mô tả của bạn ở bài 1, chắc chắn có sự nhầm lẫn.
Giữa của bạn là nói về vị trí hay số lượng? Mình xem 1 vài lần nhưng vẫn không hiểu rõ vì yêu cầu bài 1 và kết quả của bai 11 trái ngược nhau
Upvote
0
Dạ 2 bác hiểu lầm ý e rồi.Ngay từ đầu e đã nói đến ĐẦU,GIỮA,CUỐI.
Bài 1 có:
0
0
0.697
0.697
1.825
1.825
3.65
3.65
Cái e cần là xóa 0.697 vì ĐẦU là 0,GIỮA là 1.825,CUỐI là 3.65.
1.825 là số nằm giữa 0 và 3.65.Bài 11 phải xóa hàng có giá trị 3.23 và 2.685.Ý e là vậy 2 bác ah.Mong 2 bác giúp e.Cảm ơn 2 bác nhiều.
Lần chỉnh sửa cuối:
Upvote
0
Số giữa là sô 1.725 mà bác.Số cuối chia cho 2 ra kết quả là số GIỮA bác ah.Cảm ơn bác nhiều.
Lần chỉnh sửa cuối:
Upvote
0
concogia
Gội rồi mới Cạo
- Tham gia
- 17/9/09
- Bài viết
- 3,412
- Được thích
- 6,881
Hiểu dzồi, nhưng còn cái này nữa
Số lượng những số xuất hiện trong vùng trùng cột A & B có phải chỉ dao động là 3 hoặc 4 không hay nó nhiều hơn 4
Số ở giữa phải đảm bảo luôn luôn có nhé
Híc, bài này hay đây
Số lượng những số xuất hiện trong vùng trùng cột A & B có phải chỉ dao động là 3 hoặc 4 không hay nó nhiều hơn 4
Số ở giữa phải đảm bảo luôn luôn có nhé
Híc, bài này hay đây
Lần chỉnh sửa cuối:
Upvote
0
viehoai
Thành viên gắn bó
- Tham gia
- 22/5/09
- Bài viết
- 2,599
- Được thích
- 2,908
Trời ơi! bạn không nói từ đầu để mất thời gian
Test code này xem sao nhé
Mã:
Sub DeleteRows()
Dim Tmp
Dim i As Long
On Error Resume Next
Application.ScreenUpdating = False
For i = Sheet1.[a65500].End(3).Row + 1 To 2 Step -1
If Sheet1.Range("D" & i).Value = 0 And Sheet1.Range("D" & i - 1).Value > 0 Then
Tmp = Sheet1.Range("D" & i - 1).Value
End If
If Sheet1.Range("D" & i).Value > 0 And Sheet1.Range("D" & i).Value <> Tmp / 2 And Sheet1.Range("D" & i).Value <> Tmp Then
Sheet1.Range("D" & i).EntireRow.Delete
End If
Next
Application.ScreenUpdating = True
End Sub
Lần chỉnh sửa cuối:
Upvote
0
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.
Upvote
0
Code chạy ra KQ sai rồi bác ơi.Bác test lại giùm e với.Thanks.
Upvote
0
Quang_Hải
Thành viên gạo cội
- Tham gia
- 21/2/09
- Bài viết
- 6,074
- Được thích
- 8,005
- Nghề nghiệp
- Làm đủ thứ
Xài thế này nha xem coi đúng chưa
PHP:
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
Upvote
0
Quang_Hải
Thành viên gạo cội
- Tham gia
- 21/2/09
- Bài viết
- 6,074
- Được thích
- 8,005
- Nghề nghiệp
- Làm đủ thứ
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
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
PHP:
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
Upvote
0
viehoai
Thành viên gắn bó
- Tham gia
- 22/5/09
- Bài viết
- 2,599
- Được thích
- 2,908
Anh Test giúp xem code dưới đây có nhanh hay chậm hơn nhé
Mã:
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(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..)
Lần chỉnh sửa cuối:
Upvote
0
Quang_Hải
Thành viên gạo cội
- Tham gia
- 21/2/09
- Bài viết
- 6,074
- Được thích
- 8,005
- Nghề nghiệp
- Làm đủ thứ
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.
Upvote
0
Bài viết mới nhất
Đánh số cho các cặp số chứng từ và số chứng từ đối ứng
(1 người xem)
Hàm trong excel
(1 người xem)
- Dán lên cao
- Suggestion
- Question
