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

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Tôi tuân thủ nội quy khi đăng bài
Có
V

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

Sắp xếp theo thời gian sắp xếp theo bầu chọn
Văn Toàn 1996 đã viết:
A1000
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
cantl đã viết:
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
Nhấp chuột vào đây để mở rộng...
Có thể thay dòng:
If [OHienTai] = 7 Or [OHienTai] = 8 Or [OHienTai] = 9 Or [OHienTai] = 10 Then
Thành:
if OHienTai > 6 and OHienTai < 11 then
 
Upvote 0
"Sáng kiến" nhiều quá cho nên quên những điều căn bản. Cần ngừng sáng kiến lại và chú tâm vào căn bản lập trình VBA.
Cái mà tác giả bài #2 biết nhưng lúc code lại quên:
- Khi xóa nhiều dòng, đi ngược từ dưới lên trên.

Chú: giải thuật chính của bài này là Advanced Filter.
 
Upvote 0
Hoàng Tuấn 868 đã viết:
Tham khảo thêm một cách.
Nhấp chuột vào đây để mở rộng...
Bạn có lẽ không hiểu bài #4 nói gì.
Chủ thớt này là loại đặc biệt, chỉ có một, không có hai trong GPE. Code tải về sẽ được viết lại cho "tối ưu".
Chịu khó đợi không bao lâu (*) sẽ có code tối ưu ấy do chính thớt đưa lên.

(*) Thớt có máy vượt thời gian:
- có cái nhìn trước mọi người 10 năm.
- có thể thực hiện một lượt test code 3 tháng trong vòng 1 phút.
 
Upvote 0
befaint đã viết:
Chà chà.
Cốt mà chưa tét kỹ trong phòng thí nghiệm 3 tháng mà đã đăng lên là dở rồi.
Nhấp chuột vào đây để mở rộng...
1. "Sửa, sửa nữa, sửa mãi". Chắc có lỗi nhưng nó đang chạy rẹt rẹt. --=0--=0--=0
VetMini đã viết:
Khi xóa nhiều dòng, đi ngược từ dưới lên trên
Nhấp chuột vào đây để mở rộng...
Mã: 
Option Explicit

Sub zzz()
Dim i&
Dim OHienTai As Range
For i = 1000 To 1 Step -1
Set OHienTai = Range("A" & i)
If (OHienTai.Row - 1) Mod 10 + 1 > 6 Then
OHienTai.EntireRow.Delete
End If
Next
End Sub

2. Em là Sáng kiến, code chạy, quay lại 1.
VetMini đã viết:
Advanced Filter
Nhấp chuột vào đây để mở rộng...
phức tạp nhắm. _)()(-_)()(-_)()(-
Hoàng Tuấn 868 đã viết:
thêm
Nhấp chuột vào đây để mở rộng...
Union, 1 phát ăn ngay. :cool::cool::cool:
 
Upvote 0
cantl đã viết:
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
Nhấp chuột vào đây để mở rộng...
7 8 9 10 có để minh họa dòng đó là dòng xóa chứ không ô đó mặc định là số 7,8,9,10
Bài đã được tự động gộp:

cantl đã viết:
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
Nhấp chuột vào đây để mở rộng...
7 8 9 10 có để minh họa dòng đó là dòng xóa chứ không ô đó mặc định là số 7,8,9,10
Bài đã được tự động gộp:

cantl đã viết:
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
Nhấp chuột vào đây để mở rộng...
7 8 9 10 có để minh họa dòng đó là dòng xóa chứ không ô đó mặc định là số 7,8,9,10
cantl đã viết:
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
Nhấp chuột vào đây để mở rộng...
số 7,8,9,10 là minh họa dòng đó là dòng xóa nên không thể đưa vào điều kiện. Ví dụ như vầy thì làm sao xóa
1706171973160.png
Bài đã được tự động gộp:

cantl đã viết:
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
Nhấp chuột vào đây để mở rộng...
7 8 9 10 có để minh họa dòng đó là dòng xóa chứ không ô đó mặc định là số 7,8,9,10
cantl đã viết:
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
Nhấp chuột vào đây để mở rộng...
số 7,8,9,10 là minh họa dòng đó là dòng xóa nên không thể đưa vào điều kiện. Ví dụ như vầy thì làm sao xóa
1706171973160.png
 
Upvote 0
Upvote 0
Đó.

Bài #9 kìa. Cần suy diễn sâu và rộng là cả 2 con số 6 và 4 chỉ là minh hoạ. Tối đa là 6, còn 4 thì chỉ có cho vui. :p

Tầm nhìn xa 10+ cây số ló phải khác á.
 
Upvote 0
Dùng phương pháp xử lý XML để còn Undo và giữ được định dạng bạn nhé
 
Upvote 0
Vòng lặp i từ (x + 7) đến 1, bước -10. Xóa 4 dòng từ dòng i.
x là số tròn chục của STT dòng dữ liệu cuối cùng.
 
Upvote 0
@Văn Toàn 1996
Bạn có thể chép mã dưới đây vào một module mới, và gán Macro sau vào nút:

'ClearContentsByXMLPaste [A1:C60], 6, 4'

Có nghĩa là sẽ xóa cách 6 hàng xóa 4 hàng trong vùng [A1:C60]

Ưu điểm của cách xóa này là: Xóa giữ định dạng, giữ công thức, và có thể Undo và Redo, viết mã một lần có thể gọi lại.

JavaScript: 
Option Explicit
#If VBA7 = 0 Then
    Public Enum LongPtr:[_]:End Enum
#End If
Private Const PtrNull As LongPtr = 0
Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_ZEROINIT = &H40
Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)        'Use for hwnd
Private Const NAME_MAX_LENGTH = 1024

#If VBA7 Then
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As LongPtr) As Long
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As LongPtr) As LongPtr
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
Private Declare PtrSafe Function wstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As LongPtr) As Long
Private Declare PtrSafe Function wstrcpy Lib "kernel32" Alias "lstrcpyW" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
Private Declare PtrSafe Function RegisterClipboardFormat Lib "user32" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As LongPtr
Private Declare PtrSafe Function EnumClipboardFormats Lib "user32" (ByVal wFormat As LongPtr) As LongPtr
Private Declare PtrSafe Function GetClipboardFormatName Lib "user32" Alias "GetClipboardFormatNameA" (ByVal wFormat As LongPtr, ByVal lpString As String, ByVal nMaxCount As Long) As LongPtr
Private Declare PtrSafe Function GlobalFree Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
#Else
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function RegisterClipboardFormat Lib "user32" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function GetClipBoardData Lib "user32" Alias "GetClipboardData" (ByVal wFormat As Long) As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function EnumClipboardFormats Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardFormatName Lib "user32" Alias "GetClipboardFormatNameA" (ByVal wFormat As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Private Declare Function wstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
Private Declare Function wstrcpy Lib "kernel32" Alias "lstrcpyW" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long

#End If


Private Sub ClearContentsByXMLPaste_test()

  Debug.Print Sheet1.[A1:C20].Value(11)
 ' ClearContentsByXMLPaste [A1:C60], 6, 4
End Sub

Sub ClearContentsByXMLPaste(ByVal table As Range, Optional ByVal stepRows& = 1, Optional ByVal ClearRows&)
  On Error Resume Next
  Dim a, i&, k&, r&, lr&, lr2&, fr&, fr2&, lc&
  Dim vh$, re, ms, s1$, ri&, cr&, kr&, ss$, ss2$
  lr = table.Rows.CountLarge
  lc = table.Columns.CountLarge
  a = table.Value
  stepRows = IIf(stepRows < 1, 1, stepRows)
  ClearRows = IIf(ClearRows < 1, 1, ClearRows)
  cr = stepRows + ClearRows
  Set re = CreateObject("VBScript.RegExp")
  With re:  .Global = 1: .IgnoreCase = 1: .MultiLine = 1
  End With
  vh = table.Value(11)
  re.Pattern = "<!--(.*?)-->|\r?\n\s*\B"
  If re.test(vh) Then vh = re.Replace(vh, "")
  re.Pattern = "<Row( ss:Index=""(\d+)"")?([^>]*>.*?</Row>)"
  Set ms = re.Execute(vh)
  If ms.Count = 0 Then Exit Sub
  r = 0
  ss = Left$(vh, ms(0).firstIndex)
  ss2 = Mid$(vh, ms(ms.Count - 1).firstIndex + ms(ms.Count - 1).Length + 1)
  lr2 = ms.Count - 1
  For i = 0 To lr2
    s1 = ms(i).submatches(0)
    If s1 <> "" Then ri = CLng(ms(i).submatches(1))
    r = IIf(s1 = "", r + 1, ri)
    fr2 = (r - 1) \ cr
    fr = ((r - 1) Mod cr) + 1
    If fr > stepRows Then
      If s1 <> "" Then kr = ri
    Else
      If kr > 0 Then
        ss = ss & "<Row ss:Index=""" & kr & """" & ms(i).submatches(2)
      Else
        If s1 <> "" And r > stepRows Then
          ss = ss & "<Row ss:Index=""" & CStr(ri) & """" & ms(i).submatches(2)
        Else
          ss = ss & ms(i)
        End If
      End If
    End If
  Next
  DoEvents: Application.Goto table(1, 1), False
  ClipboardSetXML encodeTextXML2(ss & "<Row ss:Index=""" & CStr(lr) & """></Row>" & ss2)
  DoEvents: CreateObject("WScript.Shell").SendKeys "^v", False

End Sub

Private Function encodeTextXML(ByVal Text$)
  Dim L, i, x, t, m
  x = 1
L:
  L = Len(Text)
  For i = x To L
    t = Mid(Text, i, 1): m = AscW(t)
    If m < 0 Then m = m + 65536
    Select Case m
    Case Is > 127, 60, 62, 10, 13, 34, 39
      Text = Replace(Text, t, "&#" & CStr(m) & ";")
      x = i + Len(m) + 2
      GoTo L
    End Select
  Next
  encodeTextXML = Text
End Function
Private Function encodeTextXML2(ByVal Text$)
  Dim L, i, x, t, m
  x = 1
L:
  L = Len(Text)
  For i = x To L
    t = Mid(Text, i, 1): m = AscW(t)
    If m < 0 Then m = m + 65536
    Select Case m
    Case Is > 127
      Text = Replace(Text, t, "&#" & CStr(m) & ";")
      x = i + Len(m) + 2
      GoTo L
    End Select
  Next
  encodeTextXML2 = Text
End Function

Private Sub ClipboardSetXML(ByVal xml As String)
  Dim lpMemory As LongPtr
  Dim hMemory As LongPtr
  Dim wLen As Long
  Dim RetVal As Variant
  Dim memoryIsLocked As Boolean
  Dim memoryIsAllocated As Boolean
  Dim clipBoardIsOpen As Boolean
  Dim thisClipboardFormatNumber As Long
  On Error GoTo ErrorHandler
  ' Lâìy ðôò dài, bao gôÌm caÒ môòt phâÌn bôÒ sung cho vbNullChar õÒ cuôìi.
  wLen = Len(xml) + 1
  ' ’ Thêm môòt giá triò rôÞng vào cuôìi
  xml = xml & vbNullChar
  ' ’ Câìp phát môòt sôì bôò nhõì
  hMemory = GlobalAlloc(GHND, wLen + 1)
  If hMemory = PtrNull Then
    Err.Raise vbObjectError + 1001, "vbaClipboard", "Unable To allocate memory."
  Else
    memoryIsAllocated = True
  End If
  lpMemory = GlobalLock(hMemory)
  If lpMemory = PtrNull Then
    ' Ném môòt lôÞi
    Err.Raise vbObjectError + 1001, "vbaClipboard", "Unable To lock memory."
  Else
    memoryIsLocked = True
  End If
  ' Sao chép chuôÞi cuÒa chúng tôi vào bôò nhõì biò khóa.
  RetVal = lstrcpy(lpMemory, xml)
  ' ÐýÌng gýÒi bôò nhõì biò khóa clipboard.
  RetVal = GlobalUnlock(hMemory)
  ' Nêìu phâÌn trýõìc ðýa ra lôÞi, nó seÞ ðýõòc xýÒ lyì trong TriÌnh xýÒ lyì lôÞi
  memoryIsLocked = True
  If OpenClipboard(0&) = PtrNull Then
    Err.Raise vbObjectError + 1, "vbaClipboard", "Unable To open Clipboard. Perhaps some other application Is using it."
  Else
    clipBoardIsOpen = True
  End If
  ' Ðiònh daòng ðýõòc yêu câÌu có phaÒi là môòt trong nhýÞng ðiònh daòng ðýõòc tích hõòp sãÞn trong Windows không?
  Dim i As Integer
  If thisClipboardFormatNumber = 0 Then
    ' Không. Ðãng kyì ðiònh daòng
    On Error Resume Next
    thisClipboardFormatNumber = CLng(RegisterClipboardFormat("XML Spreadsheet")) 'Note: Adding this to support 64Bit
    If Err.Number <> 0 Then
      Err.Raise vbObjectError + 1, "vbaClipboard", "Unable To register clipboard format: " & "XML Spreadsheet" & _
      ". Error message: " & Err.description
    End If
    On Error GoTo ErrorHandler
    If thisClipboardFormatNumber = 0 Then Err.Raise vbObjectError + 1, "vbaClipboard", "Unable To register clipboard format: " & "XML Spreadsheet"
  End If
 ' Làm trôìng clipboard
  If EmptyClipboard() = PtrNull Then Err.Raise vbObjectError + 1, "vbaClipboard", "Unable To Empty the clipboard."
  If SetClipboardData(thisClipboardFormatNumber, hMemory) = PtrNull Then Err.Raise vbObjectError + 1, "vbaClipboard", "Unable To Set the clipboard data."
  CloseClipboard
  GlobalFree hMemory
  Exit Sub
ErrorHandler:
  Dim description As String
  description = Err.description
  On Error Resume Next
  If memoryIsLocked Then GlobalUnlock hMemory
  If memoryIsAllocated Then GlobalFree hMemory
  If clipBoardIsOpen Then CloseClipboard
  On Error GoTo 0
  Err.Raise vbObjectError + 1, "vbaClipboard", description
End Sub
 

File đính kèm

Upvote 0
huuthang_bd đã viết:
Vòng lặp i từ (x + 7) đến 1, bước -10. Xóa 4 dòng từ dòng i.
x là số tròn chục của STT dòng dữ liệu cuối cùng.
Nhấp chuột vào đây để mở rộng...
(/iết theo hướng dẫn của bài đăng tác gia HuuThang:
PHP: 
Sub Xoa4DongCua1chuc()
 Dim Rws As Long, J As Long, Dg As Integer
 Dim dRng As Range
 
 Rws = [B7].Parent.UsedRange.Rows.Count
 Set dRng = Rows(Rws + 9 & ":" & Rws + 9)
 Dg = Chuc(Rws)
 For J = Dg To 1 Step -10
    Set dRng = Union(dRng, Rows(J & ":" & J - 3))
 Next J
 MsgBox dRng.Address
End Sub
Mã: 
Function Chuc(ByVal NumR As Integer) As Integer
 Chuc = NumR + Choose(1 + (NumR Mod 10), 0, 9, 8, 7, 6, 5, 4, 3, 2, 1)
End Function
 
Upvote 0
Phải nhìn nhận quý vị siêng viết code hoành tráng thật.
Tôi thì lười lắm. Code làm được việc là tốt rồi, không cần nhanh chậm.

Sub t()
For i = 1000 To 1 Step -10
Cells(i - 3, 1).Resize(4).EntireRow.Delete
Next i
End Sub
 
Upvote 0
VetMini đã viết:
Phải nhìn nhận quý vị siêng viết code hoành tráng thật.
Tôi thì lười lắm. Code làm được việc là tốt rồi, không cần nhanh chậm.

Sub t()
For i = 1000 To 1 Step -10
Cells(i - 3, 1).Resize(4).EntireRow.Delete
Next i
End Sub
Nhấp chuột vào đây để mở rộng...
Quá tối ưu về dòng, tiết kiệm rất nhiều khoảng trống. --=0 --=0 --=0

Mà bác ít code nên không biết thẻ rồi. :p:p:p
 
Upvote 0
cantl đã viết:
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
Nhấp chuột vào đây để mở rộng...
Lệnh Delete Range, bác sử dụng quá tùy tiện. Các lỗi của cách viết mã như trên:
1. Mỗi lần Delete là toàn bộ công thức trong trang tính sẽ tính toán lại, chứ không riêng gì các công thức liên quan đến vùng đã xóa. Vòng lặp sẽ gọi rất nhiều lần Delete.
2. Nếu dưới 1000 dòng có một vùng dữ liệu khác, vùng ô đó sẽ dịch chuyển lên.
3. Giải thuật không có.
 
Upvote 0
HeSanbi đã viết:
Lệnh Delete Range, bác sử dụng quá tùy tiện. Các lỗi của cách viết mã như trên:
1. Mỗi lần Delete là toàn bộ công thức trong trang tính sẽ tính toán lại, chứ không riêng gì các công thức liên quan đến vùng đã xóa. Vòng lặp sẽ gọi rất nhiều lần Delete.
2. Nếu dưới 1000 dòng có một vùng dữ liệu khác, vùng ô đó sẽ dịch chuyển lên.
3. Giải thuật không có.
Nhấp chuột vào đây để mở rộng...

Đúng là tớ code rất dỏm, vì tớ học code theo kiểu từ ngọn về gốc. Vì thế nên cứ ra kết quả là tớ mãn nguyện rồi.

Việc dữ liệu nhiều hay ít thì nó lại là đặc trưng của mỗi một bài, chắc là trách tác giả đưa ra dữ liệu ban đầu 1.000 dòng và cứ 1 đến 10 liên tục.

Tớ cũng rất hâm mộ code của bạn nhưng mà để đọc hiểu thì quá sức của tớ.

Nói chung phải cần các bạn trên diễn đàn hỗ trợ nhiều. _)(#; _)(#; _)(#;
 
Upvote 0
Upvote 0
HeSanbi đã viết:
. . . ;.
1. . . . .
2. Nếu dưới 1000 dòng có một vùng dữ liệu khác, vùng ô đó sẽ dịch chuyển lên.
3. . . . .
Nhấp chuột vào đây để mở rộng...
Cách để khắc phục nhược điểm (2) này cũng có & mình nghỉ là vầy:
a./ Tìm dòng cuối có DL (dữ liệu) của vùng 'trên' & gán vô biến Rws;
b./ Khai báo 1 mảng để chứa DL kết quả & có số dòng trùng với Rws
c./ Tạo vòng lặp duyệt từ 1 cho đến Rws;
d./ Chỉ ghi vô mảng các dòng DL thỏa (Khác 7, 8, 9 & 10, . . . .)
e./ Ghi DL từ mảng lên trang tính;

Mong các nhận xét của các bạn gần xa!
 
Upvote 0
Bác đã có dòng để nhét vào hàm Chuc() rồi thì cứ lấy dòng đấy chèn 4 dòng trống sau mỗi vòng lặp thôi mà.
SA_DQ đã viết:
Cách để khắc phục nhược điểm (2)
Nhấp chuột vào đây để mở rộng...
cho các vùng bên dưới, ví dụ có 5 vùng cách nhau, em chưa nghĩ được cách để tìm dòng giới hạn của từng vùng.
Code bạn bi hay chỗ Undo được. Còn xóa mà không đẩy lên thì em cũng thấy hơi lạ, cần phải có ứng dụng điển hình mới được.

Còn bác có đam mê tối ưu thì đây, em trình code đểu trước + code Google dịch từ tiếng Việt sang tiếng VBA của bác Thắng luôn, dịch y từng chữ.

Và Chuc() của bác hại não quá, em phải lập bảng mới hiểu được.
Mã: 
Option Explicit

Sub Xoa4DongCua1chuc()
Dim x&, i&
x = Chuc(Cells(Rows.Count, "A").End(xlUp).Row)
For i = (x + 7) To 1 Step -10
Cells(i, 1).Resize(4).EntireRow.Delete
Next
End Sub

Function Chuc(NumR As Integer)
 Chuc = Int(NumR / 10) * 10
End Function

Sub zzz()
Dim i&, DongDau&, DongCuoi&
Dim OHienTai As Range, OVung As Range, VVung As Range
Set OVung = Application.InputBox("Chon vung:", , , , , , , 8)
Set VVung = OVung.CurrentRegion
DongCuoi = VVung.End(xlDown).Row
DongDau = Cells(DongCuoi, "A").End(xlUp).Row
For i = DongCuoi To DongDau Step -1
Set OHienTai = Range("A" & i)
If (OHienTai.Row - (DongDau - 1) - 1) Mod 10 + 1 > 6 Then
OHienTai.EntireRow.Delete
Cells(DongCuoi + 1, "A").EntireRow.Insert
End If
Next
End Sub
 

File đính kèm

Upvote 0
cantl đã viết:
cho các vùng bên dưới, ví dụ có 5 vùng cách nhau, em chưa nghĩ được cách để tìm dòng giới hạn của từng vùng.
Nhấp chuột vào đây để mở rộng...
Đây là cách thô nhất có thể để tìm ra dòng cuối của vùng 1 (trên nhất) có chứa dữ liệu:
PHP: 
Sub TimDongCuoiCuaVung1()
 Dim fRw As Integer, lRw As Long
 
 If [A1].Value <> Space(0) Then
    fRw = 1
 Else
    fRw = [A1].End(xlDown).Row
 End If
 lRw = Cells(fRw, "A").End(xlDown).Row
 MsgBox lRw
End Sub
 
Upvote 0
@cantl Lệnh Delete và Insert Range chỉ sử dụng trong tình thế cần mới nên sử dụng.
Dưới đây là một đoạn mã dùng giải thuật dồn hàng an toàn. Và viết ít mã hơn.
Nếu gọi lần 2 trong vòng 7 giây sẽ hoàn tác.
(Nếu sử dụng phương pháp xử lý XML sẽ giữ được Công thức, nếu có.)
JavaScript: 
Private Sub ClearStepRows_test()
 ClearStepRows [A1:C60], 6, 4
End Sub
Sub ClearStepRows(ByVal table As Range, Optional ByVal stepRows& = 1, Optional ByVal ClearRows& = 1)
  Dim d$: d = table.Address(0, 0, , 1)
  Static t!, a, s$:
  If table Is Nothing Then a = Empty: t = 0: s = Empty: Exit Sub
  If t > 0 And (Timer - t < 0) Then
    If d = s Then table = a: t = 0: Exit Sub
  End If
  Dim k&, r&, lr&, fr&, lc&, c&, z
  a = table.Value
  lr = UBound(a): lc = UBound(a, 2)
  stepRows = IIf(stepRows < 1, 1, stepRows)
  ClearRows = IIf(ClearRows < 1, 1, ClearRows)
  ReDim z(1 To lr, 1 To lc)
  While r < lr
    r = r + 1
    For c = 1 To lc
      z(r - k, c) = a(r, c)
    Next c
    fr = ((r - 1) Mod cr) + 1
    If fr >= stepRows Then r = r + ClearRows: k = k + ClearRows
  Wend
  table = z
  t = Timer + 7: s = d
  Application.OnTime Now + TimeSerial(0, 0, 7), "'" & ThisWorkbook.Name & "'!ClearStepRows_FreeMemory"
End Sub

Sub ClearStepRows_FreeMemory()
  ClearStepRows Nothing
End Sub


Dưới đây là đoạn mã sử dụng lệnh Delete Range, mã này không áp dụng cho mỗi 2 dòng được Gộp ô:

JavaScript: 
Private Sub DeleteStepRows_test()
  DeleteStepRows [A1:C60], 6, 4
End Sub

Sub DeleteStepRows(ByVal table As Range, Optional ByVal stepRows& = 1, Optional ByVal ClearRows& = 1)
  Dim k&, r&, lr&, lc&, cr&, rg As Range
  stepRows = IIf(stepRows < 1, 1, stepRows)
  ClearRows = IIf(ClearRows < 1, 1, ClearRows)
  cr = stepRows + ClearRows
  If MsgBox("Xóa vùng ô " & table.Address(0, 0) & ":" & vbLf & _
            "   Cách " & stepRows & " xóa " & ClearRows & " dong" & vbLf & _
            "        (Hanh dong nay không the hoan tac)" & vbLf & _
            "        Tiêp tuc?", _
         vbYesNo, Title:="Rows Delete") <> vbYes Then Exit Sub
  lr = table.rows.CountLarge:
  lc = table.columns.CountLarge:
  While r < lr
    r = r + stepRows
    If Not rg Is Nothing Then
      Set rg = Union(rg, table(r + 1, 1).Resize(ClearRows, lc))
    Else
      Set rg = table(r + 1, 1).Resize(ClearRows, lc)
    End If
    r = r + ClearRows
  Wend
  If Not rg Is Nothing Then rg.Delete xlShiftUp

End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
cantl đã viết:
Code bạn bi hay chỗ Undo được. Còn xóa mà không đẩy lên thì em cũng thấy hơi lạ, cần phải có ứng dụng điển hình mới được.
Nhấp chuột vào đây để mở rộng...
Do với cách làm đó thì không thể làm cho phần dữ liệu bên dưới đẩy lên theo được. Nhưng thay vì nói rõ nhược điểm đó tác giả lại cố tình nói việc đẩy dữ liệu lên như bình thường là nhược điểm để bạn ngầm hiểu không đẩy dữ liệu lên là ưu điểm. :D
Code mà thấy dùng Sendkey là tôi không khoái rồi. Làm theo hướng đó thì cũng không cần phải dùng một đống API như vậy.
 
Upvote 0
Tôi xóa các bài tranh cãi bên trên, đồng thời cảnh cáo nick @HeSanbi và ban nick 1 tháng do dùng từ ngữ để mắng chửi người khác mà lại mang tính vơ đũa cả nắm.
Tôi cũng là người không thích dùng API, nếu viết code bằng VBA dược bằng năm ba dòng lệnh thì không dùng API cả thước code. Như vậy tôi cũng bị chửi chung là chó à?
Trích hình ảnh trước khi xóa:

1706433980291.png
 
Upvote 0
HeSanbi đã viết:
@SA_DQ Theo em thì cách giải bài của bác
1. Sử dụng XML API
2. Giải thuật bước nhảy
3. Dùng vòng lặp
Em đang hoàn thành mã, giải thuật khó quá, nên hơi lâu
----------------------------------------------------
. . . . .
Nhấp chuột vào đây để mở rộng...
Mình xin đăng lại (gần đúng) bài hỏi của mình, để ai đó khỏi lăn tăn:
Giả sử phía dưới vùng DL (dữ liệu) thứ nhất có vài ba dòng trắng & sau đó là vùng DL thứ 2 ở bên dưới;
Vậy làm sao ta có thể xóa các dòng thứ 7 đến dòng 10 trong từng chục dòng của vùng DL thứ nhất, sao cho yên vị (không đôn) vùng DL thứ 2 lên trên.
 
Upvote 0
SA_DQ đã viết:
Mình xin đăng lại (gần đúng) bài hỏi của mình, để ai đó khỏi lăn tăn:
Giả sử phía dưới vùng DL (dữ liệu) thứ nhất có vài ba dòng trắng & sau đó là vùng DL thứ 2 ở bên dưới;
Vậy làm sao ta có thể xóa các dòng thứ 7 đến dòng 10 trong từng chục dòng của vùng DL thứ nhất, sao cho yên vị (không đôn) vùng DL thứ 2 lên trên.
Nhấp chuột vào đây để mở rộng...
Nếu muốn như vậy thì xóa bao nhiêu dòng thì chèn lại bấy nhiêu dòng sau dòng cuối cùng là được mà.
 
Upvote 0
Mình mới nghỉ ra cách này & tự cho là đơn giản đối với mình:

a./ Xác định dòng cuối (lRws) có DL (dữ liệu) của vùng trên cùng (là vùng cần xóa 4 cho mỗi 1 chục dòng);
b./ Khai báo 1 mảng có chỉ số dòng bằng với trị đã xác đinh trên.
c./ Tạo vòng lặp duyệt từ 1 đến lRws;
Dòng nào không thỏa điều kiện xóa thì ghi vô mảng
d./ Chuyển DL trong mảng lên trang tính

PC: Nếu DL vùng I này không bình thường thì sẽ bổ sung chuyện xử lý sau, . . . .
 
Upvote 0
SA_DQ đã viết:
Mình mới nghỉ ra cách này & tự cho là đơn giản đối với mình:

a./ Xác định dòng cuối (lRws) có DL (dữ liệu) của vùng trên cùng (là vùng cần xóa 4 cho mỗi 1 chục dòng);
b./ Khai báo 1 mảng có chỉ số dòng bằng với trị đã xác đinh trên.
c./ Tạo vòng lặp duyệt từ 1 đến lRws;
Dòng nào không thỏa điều kiện xóa thì ghi vô mảng
d./ Chuyển DL trong mảng lên trang tính

PC: Nếu DL vùng I này không bình thường thì sẽ bổ sung chuyện xử lý sau, . . . .
Nhấp chuột vào đây để mở rộng...
Cách của bác giống bạn HeSanbi. Code bạn ấy có Ctrl+V.
Khổ thân bạn ấy, ban nick nên gõ @ không triệu hồi được. :wallbash: :wallbash: :wallbash:
 
Upvote 0
Dùng SendKey mà không ghi chú to đùng lên rằng "Khi thực hiện cấm người dùng động đậy bàn phím" thì vứt rồi.

Lại còn dùng Union nữa chứ. Union tưởng là ngon nhưng chẳng ngon tẹo nào, có một giới hạn mà tại đó union lăn ra đơ đơ (có một chủ đề về vấn đề này rồi). Kinh nghiệm còn non hoặc chưa chịu khó tét code trong phòng thí nghiệm đủ 3 tháng rồi.
 
Upvote 0
Mã: 
Sub Xoa_Dong()
Dim sArr(), dArr(), k As Long, i As Long, ii As Long
sArr = Range("A1", Range("A" & Rows.Count).End(3)).Resize(, 2).Value
ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2))
For i = 1 To UBound(sArr) - 4 Step 10
    For ii = 0 To 5
        k = k + 1
        dArr(k, 1) = sArr(i + ii, 1)
        dArr(k, 2) = sArr(i + ii, 2)
    Next
Next
Range("E1").Resize(k, UBound(dArr, 2)) = dArr
End Sub
Theo mình thì code cơ bản chắc cũng được rồi
 
Upvote 0
ptm0412 đã viết:
Cách của bác Sa làm gì có copy paste mà có Ctrl V?
Nhấp chuột vào đây để mở rộng...
À, theo cách hiểu không bài bản của em thì cứ gắn mảng xuống bảng tính thì nó cũng giống giống control v.
Còn cách thức chính xác thì em cũng không biết gọi tên là gì. :wallbash: :wallbash: :wallbash:
 
Upvote 0
À 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
befaint đã viết:
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.
Nhấp chuột vào đây để mở rộng...
Ô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
cantl đã viế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?
Nhấp chuột vào đây để mở rộng...
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
VetMini đã viết:
Kết luận: chỉ cần một mảng, đầu ra ghi chồng lên đầu vào.
Nhấp chuột vào đây để mở rộng...
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
cantl đã viết:
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 ạ?
Nhấp chuột vào đây để mở rộng...
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
VetMini đã viết:
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ì?
Nhấp chuột vào đây để mở rộng...
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
ptm0412 đã viết:
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.
...
Nhấp chuột vào đây để mở rộng...
Đ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
cantl đã viết:
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
Nhấp chuột vào đây để mở rộng...

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
cantl đã viết:
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
Nhấp chuột vào đây để mở rộng...
Bạn ơi.
Xóa từ dưới lên trên chớ hỳ
 
Upvote 0
SA_DQ đã viết:
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!
Nhấp chuột vào đây để mở rộng...
Đâ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.
Tuan.DNa đã viết:
Bạn ơi.
Xóa từ dưới lên trên chớ hỳ
Nhấp chuột vào đây để mở rộng...
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
cantl đã viết:
. . . . 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.
Nhấp chuột vào đây để mở rộ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
cantl đã viết:
Đâ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.
Nhấp chuột vào đây để mở rộ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
SA_DQ đã viết:
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./ . . . . (?)
Nhấp chuột vào đây để mở rộng...
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
CHAOQUAY đã viết:
Làm từ dưới lên hay trên xuống cũng không rõ nữa
Nhấp chuột vào đây để mở rộng...
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
cantl đã viết:
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
...
Nhấp chuột vào đây để mở rộng...
Khổ ở chỗ bạn không bao giờ nghĩ đến "lực bất tòng tâm"
Trước khi "giúp người" thì cũng cần phải biết có giúp được không. Bạn gặp một người tai nạn nằm giữa đường, bạn nhới lại xem phim thấy người ta hô hấp nhân tạo rần rần, thế là bạn ttrowrnajn nhơn (đâu có biết thế nào là thế nằm đúng), đè ngực:
Rắc, gãy xương sườn. Bât giờ chỉ là phước chủ may thầy, cái xương ấy có bị bạn đè đâm lủng phổi hay không thôi.

Cái xương sườn ấy có thể ví như câu "On error" của bạn. Bạn không quan sát, cứ đè ngực tiếp thì khả năng nó đâm phổi càng tăng cao.
 
Upvote 0
VetMini đã viết:
Khổ ở chỗ bạn không bao giờ nghĩ đến "lực bất tòng tâm"
Trước khi "giúp người" thì cũng cần phải biết có giúp được không. Bạn gặp một người tai nạn nằm giữa đường, bạn nhới lại xem phim thấy người ta hô hấp nhân tạo rần rần, thế là bạn ttrowrnajn nhơn (đâu có biết thế nào là thế nằm đúng), đè ngực:
Rắc, gãy xương sườn. Bât giờ chỉ là phước chủ may thầy, cái xương ấy có bị bạn đè đâm lủng phổi hay không thôi.

Cái xương sườn ấy có thể ví như câu "On error" của bạn. Bạn không quan sát, cứ đè ngực tiếp thì khả năng nó đâm phổi càng tăng cao.
Nhấp chuột vào đây để mở rộng...
Nghe lời bác, không tham gia code kiếc, hàm hiếc gì nữa. Tập trung tham gia chuyên mục Thư giãn. Muối mặt, muối tiêu, muối tổng hợp.
 
Upvote 0
cantl đã viết:
Nghe lời bác, không tham gia code kiếc, hàm hiếc gì nữa. Tập trung tham gia chuyên mục Thư giãn. Muối mặt, muối tiêu, muối tổng hợp.
Nhấp chuột vào đây để mở rộng...
Tôi nghĩ là bạn ham học cho nên tôi mới nặng tay. Trước đây cũng có 2 cô tôi nghĩ vậy, và dù là nữ tôi vẫn nặng lời. Một cô thì tôi lầm. Cô kia thì tôi không nghĩ là mình lầm.
Nếu bạn thuộc lại cực đoan, để cho cục tự ái nó đè lên niềm khát vọng thì cứ xác định. Tôi sẽ chừa bạn ra.
 
Upvote 0
VetMini đã viết:
Tôi nghĩ là bạn ham học cho nên tôi mới nặng tay. Trước đây cũng có 2 cô tôi nghĩ vậy, và dù là nữ tôi vẫn nặng lời. Một cô thì tôi lầm. Cô kia thì tôi không nghĩ là mình lầm.
Nếu bạn thuộc lại cực đoan, để cho cục tự ái nó đè lên niềm khát vọng thì cứ xác định. Tôi sẽ chừa bạn ra.
Nhấp chuột vào đây để mở rộng...
Em không ham học, em chỉ đam mê, thực sự là đam mê. Đam mê nghĩa là lúc mê lúc không, khác với mọi người là đam mê thật.

Còn tự ái thì ai chả có. Trên này nhiều người chọc vào tự ái lắm, nhưng ý của bác cực bực, nó gây ức chế cục bộ.

Mà thôi, giờ em chỉ tập trung chuyên mục giải trí thôi. --=0 --=0 --=0
 
Upvote 0
cantl đã viết:
Em không ham học, em chỉ đam mê, thực sự là đam mê. Đam mê nghĩa là lúc mê lúc không, khác với mọi người là đam mê thật.

Còn tự ái thì ai chả có. Trên này nhiều người chọc vào tự ái lắm, nhưng ý của bác cực bực, nó gây ức chế cục bộ.

Mà thôi, giờ em chỉ tập trung chuyên mục giải trí thôi. --=0 --=0 --=0
Nhấp chuột vào đây để mở rộng...
Được. Tôi xin lỗi bạn.
Bạn không cần phải tránh mấy thớt lập trình, vì tôi cam kết sẽ không đụng chạm gì đến bạn nữa.
 
Upvote 0
VetMini đã viết:
Được. Tôi xin lỗi bạn.
Bạn không cần phải tránh mấy thớt lập trình, vì tôi cam kết sẽ không đụng chạm gì đến bạn nữa.
Nhấp chuột vào đây để mở rộng...
Em không dám nhận đâu. Nhưng kể ra bác cũng dễ thương, dùng kỹ thuật vừa đấm vừa xoa.

Thế thì em lại quay lại. --=0--=0--=0

Nhưng cũng biết thân biết phận, hạn chế đăng bài đua đòi.
 
Upvote 0
Bài 1 của chủ đề này ấy ... họ không biết code két nên mới hỏi . .. thay vì viết thuần VBA cho họ có cơ hội học với như mấy bài trước thì tầm trên 10 dòng code là nhiều và code đơn giản họ có thể hiểu và học vvv...............

Nếu giõi hơn thay vì họ viết 10 dòng để xử lý tốt cùng một vấn đề thì mình chỉ viết 9 dòng hay 5 dòng thôi thì đó mới là giỏi

thay vì 9 dòng hay 5 dòng thì bê một mớ code rác cả vài trăm dòng code vào cùng xử lý một vấn đề và chủ thớt học được gì từ mớ rác đó

nếu viết 5 to 9 dòng code thì siêu thật còn đâu đó viết vài trăm dòng code cũng chỉ xử lý một vấn đề như khoãng 10 dòng code thì nó trở thành siêu sọt rác mất rồi còn gì nữa ... --=0--=0--=0 không biết não gì ấy
 
Upvote 0
Kiều Mạnh đã viết:
Bài 1 của chủ đề này ấy ... họ không biết code két nên mới hỏi . .. thay vì viết thuần VBA cho họ có cơ hội học với như mấy bài trước thì tầm trên 10 dòng code là nhiều và code đơn giản họ có thể hiểu và học vvv...............

Nếu giõi hơn thay vì họ viết 10 dòng để xử lý tốt cùng một vấn đề thì mình chỉ viết 9 dòng hay 5 dòng thôi thì đó mới là giỏi

thay vì 9 dòng hay 5 dòng thì bê một mớ code rác cả vài trăm dòng code vào cùng xử lý một vấn đề và chủ thớt học được gì từ mớ rác đó

nếu viết 5 to 9 dòng code thì siêu thật còn đâu đó viết vài trăm dòng code cũng chỉ xử lý một vấn đề như khoãng 10 dòng code thì nó trở thành siêu sọt rác mất rồi còn gì nữa ... --=0--=0--=0 không biết não gì ấy
Nhấp chuột vào đây để mở rộng...
GPT dành cho những hỏi đơn giản
1707924468729.png
 
Upvote 0
Upvote 0
SA_DQ đã viết:
À, đã lâu rồi & nhân Tết nhất rãnh rỗi đá vài câu cho vui chăng?
Nhưng hỏi bạn, trước khi 'đá' đã thử chạy Code chưa vậy?
$$$$@
Nhấp chuột vào đây để mở rộng...
1707981099664.png
Bác cứ yên tâm thằng GPT nay lâu lâu nó cũng sai chứ không đúng hoàn toàn, em test còn kỷ lắm mùng 1 đến mùng 6 mới xong đoạn code này
 
Upvote 0
Văn Toàn 1996 đã viết:
...
Bác cứ yên tâm thằng GPT nay lâu lâu nó cũng sai chứ không đúng hoàn toàn, em test còn kỷ lắm mùng 1 đến mùng 6 mới xong đoạn code này
Nhấp chuột vào đây để mở rộng...
AI là vậy. Nguyên tắc của nó là đi từ sai đến gần đúng, rồi (hy vọng) đúng.
Thằng giỏi thì đi nhanh hơn, lắm khi nhanh đến nổi không kịp thấy chỗ sai. Vây thôi.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

N
Hàm tính chuỗi số trong 1 ô hoặc 1 dãy ô ra tổng kết quả. (2 người xem)
Trả lời
1
Đọc
37
ngocbaovu
ngocbaovu
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (4 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
382
Đọc
45K
TomRuoi
TomRuoi
NguyenthiH
Mở file Excel có Pass Open (4 người xem)
Trả lời
39
Đọc
3K
Hoàng Tuấn 868
H
M
Tách dữ liệu trong 1 file thành nhiều sheet theo số lượng dòng (2 người xem)
    • Ngạc nhiên
Trả lời
25
Đọc
3K
Hoàng Tuấn 868
H
T
Tìm số hóa đơn trong chuỗi
Trả lời
11
Đọc
407
thao nguyen01
T
T
  • Question Question
Nhờ ACE cao thủ hỗ trợ mình có một chương trình EXCEL về phân công lớp cho giáo viên (1 người xem)
Trả lời
6
Đọc
282
DeTong
D
T
Nhờ các anh chị sửa dùm công thức ạ. (1 người xem)
Trả lời
10
Đọc
152
trantrungvinh1989
T
C
Chia sẻ: Kết quả xổ số Keno
    • Cười
    • Thích
Trả lời
24
Đọc
2K
phuongdaik98
P
Phan Thế Hiệp
Quy đổi từ Thu nhập sau thuế (TNCN) ra Thu nhập tính thuế (1 người xem)
    • Yêu thích
    • Thích
Trả lời
1
Đọc
309
Phan Thế Hiệp
Phan Thế Hiệp
V
Quên mật khẩu file excel (1 người xem)
Trả lời
25
Đọc
2K
YêuCN
Y
Nguyen Rem
  • Question Question
Lỗi "User-defined type not defined" khi khai báo biến (3 người xem)
Trả lời
28
Đọc
2K
nguyendang95
N
E
Đánh số cho các cặp số chứng từ và số chứng từ đối ứng
Trả lời
13
Đọc
278
dazkangel
dazkangel
OverAC
  • Dán lên cao
  • Suggestion Suggestion
Chúc mừng sinh nhật GiaiPhapExcel 19 tuổi và tặng ebook "Lập trình VBA phần cơ bản."
    • Thích
    • Yêu thích
Trả lời
5
Đọc
1K
longlacda
L
V
Công thức để phân công chuyên môn cho giáo viên
Trả lời
5
Đọc
280
vietvanyen
V
G
AddIn convert ngày dương lịch sang âm lịch và ngược lại + đọc ngày tháng
Trả lời
20
Đọc
10K
du trung kien
D
8
Hàm trong excel
Trả lời
3
Đọc
82
Hoàng Tuấn 868
H
N
Chuyển giờ công từ bảng công vào bảng tính (7 người xem)
Trả lời
16
Đọc
317
ngouyen1505
N
N
Tạo COM Add-In bằng Visual C++
    • Thích
Trả lời
7
Đọc
687
nguyendang95
N
Nga1852k
lỗi excel không chèn được dòng và không xóa được dòng (1 người xem)
Trả lời
2
Đọc
143
Nga1852k
Nga1852k
D
  • Question Question
xin các cao thủ trợ giúp , hoặc nhận làm code có trả phí ạ (2 người xem)
Trả lời
14
Đọc
1K
tung1423
tung1423
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom