Giúp code VBa cách 6 dòng xóa 4 dòng tính từ hàng 1 trở xuống

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài

Văn Toàn 1996

Thành viên bị đình chỉ hoạt động
Thành viên bị đình chỉ hoạt động
Tham gia
5/6/23
Bài viết
106
Được thích
19
Chào các anh chị GPE. Em có 1 vùng A1:A1000 em muốn cứ cách 6 dòng, xóa đi 4 dòng thì phải dùng code VBA như thế nào. Xin cảm Ơn
1706166743501.png
 

File đính kèm

À há, code mất 2 tiếng mới ra được, sao mà cứ phải thử đi thử lại mới hết lỗi các bác ạ.
Tuy nhiên, dùng array đưa xuống sheet thì:
1. tô màu thì hỏng bét, array không giữ được màu đẹp như đầu.
2. ô mà đặt công thức thì địa chỉ nhảy tè le.
Option base 1
Mã:
Sub zzz2()
    Dim OVung As Range, VVung As Range
    Dim ArrVung, ArrKQ
    Dim i&, j&, k&, l&, m&, DongDau&, DongCuoi&
    Set OVung = Application.InputBox("Chon vung:", , , , , , , 8)
    '    Set OVung = [A6]
    Set VVung = OVung.CurrentRegion
    DongCuoi = VVung.End(xlDown).Row
    DongDau = Cells(DongCuoi, "A").End(xlUp).Row
    ArrVung = VVung.Formula
    ReDim ArrKQ(6 * (Int(UBound(ArrVung, 1) / 10)) + Application.Min(UBound(ArrVung, 1) Mod 10, 6), UBound(ArrVung, 2))
    For i = LBound(ArrVung, 1) To Int(UBound(ArrVung, 1) / 10)
        For k = 1 To 6 Step 1
            l = 10 * (i - 1) + k
            m = 6 * (i - 1) + k
            For j = LBound(ArrVung, 2) To UBound(ArrVung, 2)
                ArrKQ(m, j) = ArrVung(l, j)
            Next
        Next
    Next
    VVung.Clear
    Cells(DongDau, 1).Resize(UBound(ArrKQ, 1), UBound(ArrKQ, 2)) = ArrKQ
End Sub

LƯU Ý: CODE CHẠY SAI BÉT.

Code lụi em thấy giống chơi dao quá.
Vậy: nếu em muốn dùng VBA thì bảng phải cấm dùng công thức phải không các bác?
 

File đính kèm

  • 1706511250034.png
    1706511250034.png
    145.3 KB · Đọc: 4
Lần chỉnh sửa cuối:
Upvote 0
Chời. Thớt đâu cần dồn dữ liệu. Thớt ghi rất rõ là xoá dòng.
Và:
1706512046926.png

Mấy lần mình đã nói rằng: Ở diễn đàn này, muốn giải bài thì cần có một kỹ năng bắt buộc đó là hiểu công việc, hiểu sâu rộng, hiểu con người của chủ bài đăng câu hỏi. Bằng cách có khả năng ghi nhớ quá khứ (các bài của thớt), có khả năng tìm về quá khứ và phán đoán các vấn đề liên quan.
 
Upvote 0
Hehe, mỗi người có 1 cách mà. Bác nào code giúp cho mọi người được thì đó là giúp người, còn mình thì thử giúp người để giúp mình. --=0 --=0 --=0

Còn dồn hay không là ý tưởng bắt nguồn từ bạn bi → bác SA → tớ biến suy nghĩ thành hành động. --=0 --=0 --=0
Bằng cách có khả năng ghi nhớ quá khứ (các bài của thớt), có khả năng tìm về quá khứ và phán đoán các vấn đề liên quan.
Ông bạn siêu nhẩy, diễn đàn max 1tr, cứ cho nhớ được 1% là cũng bá đạo rồi. Chia sẻ cách nhớ nhở???
 
Upvote 0
Quý vị bị cái thói quen thành lệ của GPE nó làm hư kỹ thuật rôi.
Thói quen cứ mảng đầu ra và đầu vào là phải riêng nhau.

Bài toán này có 3 điểm
- số dòng đầu ra không thể lớn hơn đầu vào
- dữ liệu đầu vào chỉ đọc qua mỗi dòng một lần, sau đó có thể xoá hoặc ghi chồng
- đầu ra không dùng trị mặc đinh
Kết luận: chỉ cần một mảng, đầu ra ghi chồng lên đầu vào.
 
Upvote 0
...

Code lụi em thấy giống chơi dao quá.
Vậy: nếu em muốn dùng VBA thì bảng phải cấm dùng công thức phải không các bác?
Hàm là code đã có sẵn. Dùng hàm đại khái như dùng code đã có sẵn.
"dùng VBA" là code tự mình viết.

Đằng nào cũng đều là sử dụng code cả. Chọn thế nào thì tùy, giống như "vợ cả vợ hai đều là vợ cả" í bạn
 
Upvote 0
Kết luận: chỉ cần một mảng, đầu ra ghi chồng lên đầu vào.
Cứ nhiều mảng cho dễ nhìn bác, với lại đây là 2 chiều, redim chỉ được phần đuôi.
Cần lắm 1 code mẫu để hiểu mảng chồng mảng bác ạ?
 
Upvote 0
Cứ nhiều mảng cho dễ nhìn bác, với lại đây là 2 chiều, redim chỉ được phần đuôi.
Cần lắm 1 code mẫu để hiểu mảng chồng mảng bác ạ?
Bạn bị tật chủ quan, không chịu tìm hiểu người ta nói gì.
Bài toán đạt 3 điểm như đã dẫn thì redim làm cái gì?

k = 6
For i = 11 To lRws Step 10
For i2 = i To i + 5
k = k + 1
For j = 1 To lCols
a(k, j) = a(i2, j)
Next j
Next i2
Next i
rangeCanSua.ReSize(k, lCols) = a

Chỉnh sửa: sửa một chút, trước đó code để k khởi trị 1 là sai. Phải khởi là 6 mới đúng là 6 dòng đầu khỏi cần chép lại.
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn bị tật chủ quan, không chịu tìm hiểu người ta nói gì.
Bài toán đạt 3 điểm như đã dẫn thì redim làm cái gì?
Tại hắn không hiểu dùng biến k để làm gì. Mà có khi chẳng biết trước bao nhiêu dòng/ cột thì redim bao nhiêu cho vừa.
Lại còn nhầm lẫn redim với redim preserve nữa chứ. Chả hiểu cách học ra sao nữa.

Ý kiến riêng:
Xóa dòng, luôn luôn dồn dữ liệu bên dưới lên. Đó là hợp lẽ thường. Chứ 1000 dòng, xóa 400 dòng mà không lôi dữ liệu ở dưới lên thì kéo thanh trượt mỏi tay à? Nếu in thì ra 20 tờ trắng à?
 
Upvote 0
Tại hắn không hiểu dùng biến k để làm gì. Mà có khi chẳng biết trước bao nhiêu dòng/ cột thì redim bao nhiêu cho vừa.
Lại còn nhầm lẫn redim với redim preserve nữa chứ. Chả hiểu cách học ra sao nữa.
...
Đen tô đậm: Có vài lần tôi phê bình cách đặt biến đếm dòng là k. Nhưng bà con cứ theo người khởi xướng ban đầu.

Đỏ tô đậm: Đó là do cách học code trên GPE. Cũng đã vài lần tôi phê bình những lời khuyên "học code qua GPE là tốt nhất". Dân ở đây có một trường phái biểu mẫu nhất định mà học theo sẽ bị "cuốn theo dòng". Trường phái này khuyên "khai báo biến tường minh", nhưng từ tường minh của họ không bao gồm chỗ "chú thích nhiệm vụ của biến"

Đây là truonwgf hợp điển hình của "học code bằng cách đọc code". Cộng thêm tật đốt giai đoạn, không đọc kỹ cho hết của người này. Một cái là bom nổ chậm và cái kia là ngòi nổ.
 
Upvote 0
Dù sao thì em vẫn thích ghép code hơn các bác ạ. --=0 --=0 --=0

Chúc các bác ngủ ngon!!!
 
Upvote 0
Hehe, mỗi người có 1 cách mà. Bác nào code giúp cho mọi người được thì đó là giúp người, còn mình thì thử giúp người để giúp mình. --=0 --=0 --=0

Mệnh đề mình cho là hay nhất trong các bài đăng trong chủ đề này!

Chúc bạn có ngày làm việc hôm nay hiệu quả!

BS: Ghép code là sao ta, chưa hiểu!
 
Lần chỉnh sửa cuối:
Upvote 0
Code không khó lắm, quan trọng là đề bài phải dễ.
Mã:
Option Explicit

Sub zzz()
Dim i&
Dim OHienTai As Range
For i = 1 To 1000 Step 1
Set OHienTai = Range("A" & i)
If [OHienTai] = 7 Or [OHienTai] = 8 Or [OHienTai] = 9 Or [OHienTai] = 10 Then
[OHienTai].EntireRow.Delete
i = i - 1
End If
Next
End Sub
Bạn ơi.
Xóa từ dưới lên trên chớ hỳ
 
Upvote 0
Mệnh đề mình cho là hay nhất trong các bài đăng trong chủ đề này!

Chúc bạn có ngày làm việc hôm nay hiệu quả!

BS: Ghép code là sao ta, chưa hiểu!
Đây là kỹ thuật cao bác ạ, lấy mỗi nơi 1 tí, rồi sửa, cứ vài lần lỗi là sẽ được. Cái hay là không cần bẫy lỗi. Cứ chạy cứ ngon, gặp lỗi lại mò tiếp.
Bạn ơi.
Xóa từ dưới lên trên chớ hỳ
Hãy đi theo lối riêng của mình. Ai cũng xóa từ dưới lên thì lấy ai xóa từ trên xuống.
 
Upvote 0
. . . . Hãy đi theo lối riêng của mình. Ai cũng xóa từ dưới lên thì lấy ai xóa từ trên xuống.
Trên diễn đàn cũng đã có chỉ ra vài cách 'xóa' từ trên, như
1./ Những dòng nào không cần xóa thì cho vô mảng
2./ Những dòng nào cần xóa thì cho vô Rng - tham biến Range (khai báo từ trước)
3./ . . . . (?)
 
Upvote 0
Đây là kỹ thuật cao bác ạ, lấy mỗi nơi 1 tí, rồi sửa, cứ vài lần lỗi là sẽ được. Cái hay là không cần bẫy lỗi. Cứ chạy cứ ngon, gặp lỗi lại mò tiếp.

Hãy đi theo lối riêng của mình. Ai cũng xóa từ dưới lên thì lấy ai xóa từ trên xuống.
Code dưới cũng là loại cấy ghép.
Làm từ dưới lên hay trên xuống cũng không rõ nữa
Mã:
Option Explicit

Public dN As Boolean

Sub xxx()
Dim sTT() As Integer
Dim rws
Dim i, k

If dN = True Then Exit Sub
dN = True

With Sheet1
    If .AutoFilterMode Then .AutoFilterMode = False
    rws = .Range("A" & Rows.Count).End(xlUp).Row
End With

ReDim sTT(1 To rws, 1 To 1)
For i = 7 To rws Step 10
    For k = i To i + 3
        sTT(k, 1) = 1
    Next k
Next i

With Sheet1
    .Range("D1").Resize(rws, 1) = sTT
    .Range("D1").CurrentRegion.AutoFilter 1, 1
    .Range("D2", .Range("D2").End(xlDown)).EntireRow.SpecialCells(xlCellTypeVisible).Delete
    .AutoFilterMode = False
    .Range("D1").CurrentRegion.Clear
End With
End Sub
 
Upvote 0
Trên diễn đàn cũng đã có chỉ ra vài cách 'xóa' từ trên, như
1./ Những dòng nào không cần xóa thì cho vô mảng
2./ Những dòng nào cần xóa thì cho vô Rng - tham biến Range (khai báo từ trước)
3./ . . . . (?)
Bác vẫn còn đam mê món này à? Hôm qua em ghép code chưa chuẩn nên vẫn lỗi. --=0--=0--=0
Thế là em sửa 1 chút, mà vẫn lỗi, thế là em ghép thần chú resume next là ngon lành, thật đúng với châm ngôn cái gì không biết thì bỏ qua.

For i = LBound(ArrKQ, 1) To UBound(ArrKQ, 1)
On Error Resume Next

Làm từ dưới lên hay trên xuống cũng không rõ nữa
Nếu dùng filter thì oánh từ trung lộ ra biên rồi.
 
Upvote 0
Khi đưa vào mảng thì không còn khái niệm ngang, dọc, trên, dưới, trước, sau nữa.
Thậm chí LBound và Ubound còn ngược lại: L là Lower, U là Upper
Vì vào vòng lặp For sẽ là từ Ubound đến LBound hoặc ngược lại, và bởi vì LBound nhỏ hơn UBound nên đi kiểu này phải cộng tăng thêm, đi kiểu kia phải trừ bớt đi.
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom