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
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
71
Được thích
15
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

  • xoa dong.xlsx
    11.4 KB · Đọc: 9
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

  • CellsClearXML.xlsm
    32 KB · Đọc: 10
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
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

H
TÍNH PHÉP NĂM CHO NHÂN VIÊN
Trả lời
3
Đọc
96
VetMini
V
T
  • Question
Cho mình hỏi tại sao file mình chạy Sao lưu lại bị đầy bộ nhớ.
Trả lời
3
Đọc
75
BuiQuangThuan
B
phammaihuong90
Hàm tìm ngày gần nhất đạt được số lượng mục tiêu
Trả lời
4
Đọc
44
phammaihuong90
phammaihuong90
O
Kết hợp hàm value
Trả lời
1
Đọc
32
bebo021999
B
ongke0711
  • Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711)
    • Thích
    • Yêu thích
    • Cảm ơn
10 11 12
Trả lời
225
Đọc
18K
ongke0711
ongke0711
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom