Xoá số trong dãy thoả điều kiện không dùng vòng lặp

Liên hệ QC

nncb2008

Thành viên chính thức
Tham gia
14/2/08
Bài viết
88
Được thích
3
Chào các anh/chị.
Em có một dãy số nguyên, cần xoá một số và giảm các số lớn hơn nó xuống 1 đơn vị. Có cách nào không dùng vòng lặp không? Ví dụ cụ thể trong file đính kèm.
 

File đính kèm

Chào các anh/chị.
Em có một dãy số nguyên, cần xoá một số và giảm các số lớn hơn nó xuống 1 đơn vị. Có cách nào không dùng vòng lặp không? Ví dụ cụ thể trong file đính kèm.

Cái này chắc phải dùng For ... Next :

PHP:
Sub Delete()
    Dim Num As Double, Cll As Range
    Num = InputBox("Cho biet so can xoa", "NNCB")
    MsgBox "Xoa so " & Num & " va giam tat ca cac so lon hon " & Num & " xuong 1 don vi"
    For Each Cll In Range("A1", [A65536].End(xlUp))
        If Cll = Num Then
            Cll.ClearContents
        ElseIf Cll > Num Then Cll = Cll - 1
        End If
    Next Cll
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Macro của bạn đây; Nhưng cũng có 1 phần vòng lặp

PHP:
Option Explicit
Sub delete()
 On Error Resume Next
   Dim Num As Long, mNum As Long, jJ As Long
   Num = InputBox("Cho biet so can xoa", "NNCB")
   Dim MyAdd As String, Rng As Range, sRng As Range
    
   Set Rng = Range("A1:A" & [A65500].End(xlUp).Row)
   mNum = Application.WorksheetFunction.Max(Rng)
   If mNum < Num Then
      MsgBox "Khong Co So Do!", , "From GPE.COM: Exit Now"
      Exit Sub
   Else
      For jJ = Num To mNum
         Set sRng = Rng.Find(jJ, , xlFormulas, xlWhole)
         If Not sRng Is Nothing Then
            MyAdd = sRng.Address
            Do
               With sRng
                  .Value = Switch(jJ = Num, "", jJ > Num, .Value - 1)
                  .Interior.ColorIndex = Switch(jJ = Num, 3, jJ > Num, 34 + (jJ Mod 6))
               End With
               Set sRng = Rng.FindNext(sRng)
            Loop While Not sRng Is Nothing And MyAdd <> sRng.Address
         End If
      Next jJ
   End If
End Sub
 
Upvote 0
Chào các anh/chị.
Em có một dãy số nguyên, cần xoá một số và giảm các số lớn hơn nó xuống 1 đơn vị. Có cách nào không dùng vòng lặp không? Ví dụ cụ thể trong file đính kèm.
Tôi làm như vầy:
PHP:
Sub DeleteNum()
  Dim Num As Long, i As Long, Rng As Range
  On Error GoTo Thoat
  Set Rng = Application.InputBox("Chon vung", Type:=8)
  Num = InputBox("Cho biet so can xoa", "NNCB")
  If Num > WorksheetFunction.Max(Rng) Then
    MsgBox "So khong hop le": Exit Sub
  End If
  With Rng
    .AutoFilter 1, Num
    .Offset(1).SpecialCells(12).ClearContents
    .AutoFilter 1, ">" & Num
    With Intersect(.Offset(1), .Cells).SpecialCells(12)
      For i = 1 To .Areas.Count
        .Areas(i).Value = Evaluate(.Areas(i).Address & "-1")
      Next i
    End With
    .AutoFilter
  End With
Thoat:
ActiveSheet.AutoFilterMode = False
End Sub
- Vì dùng AutoFilter nên dử liệu buộc phải có 1 cell làm tiêu đề
- Vòng lập duyệt qua từng Area, đương nhiên sẽ nhanh hơn rất nhiều so với duyệt qua từng cell!
- Bài này nếu muốn không dùng đến vòng lập, bắt buộc phải sort dử liệu trước ---> Nếu bạn đồng ý tôi sẽ làm theo hướng này (không vòng lập)
 

File đính kèm

Upvote 0
Chào các anh/chị.
Em có một dãy số nguyên, cần xoá một số và giảm các số lớn hơn nó xuống 1 đơn vị. Có cách nào không dùng vòng lặp không? Ví dụ cụ thể trong file đính kèm.
Có thể dùng AutoFilter hoặc công thức
1. Dùng AutoFilter lọc ra các số đó, xóa. Dùng AutoFilter lọc ra các số lớn hơn số đó. Gõ số 1 ở một ô ngoài vùng dữ liệu, Paste Special - Add vào vùng dữ liệu.
2. Dùng VBA nhập công thức vào cột phụ và Copy, Paste Special Value lại vào dùng dữ liệu. Xóa cột phụ. Có thể viết code như thế này:
PHP:
Sub Delete()
    Dim Num As Integer
    Num = InputBox("Cho biet so can xoa", "NNCB")
    MsgBox "Xoa so " & Num & " va giam tat ca cac so lon hon " & Num & " xuong 1 don vi"
    With Range([A1], [A65536].End(xlUp))
    .Offset(, 1).FormulaR1C1 = "=IF(RC[-1]=" & Num & ","""",IF(RC[-1]>" & Num & ",RC[-1]-1,RC[-1]))"
    .Value = .Offset(, 1).Value
    .Offset(, 1).ClearContents
    End With
End Sub
 
Upvote 0
Cảm ơn các bác đã quan tâm
- Bài này nếu muốn không dùng đến vòng lập, bắt buộc phải sort dử liệu trước ---> Nếu bạn đồng ý tôi sẽ làm theo hướng này (không vòng lập)
Dữ liệu của em không phải sort, các số cùng giá trị không nằm rải rác. Cụ thể trong file đính kèm
 

File đính kèm

Upvote 0
Cảm ơn các bác đã quan tâm

Dữ liệu của em không phải sort, các số cùng giá trị không nằm rải rác. Cụ thể trong file đính kèm
Ý tôi muốn nói rằng: Nếu tôi sort lại dử liệu của bạn thì có vấn đề gì không? Nếu OK thì tôi làm thế này:
PHP:
Sub DeleteNum()
  Dim Num As Long
  On Error GoTo Thoat
  With Application.InputBox("Chon vung", Type:=8)
    Num = InputBox("Cho biet so can xoa", "NNCB")
    If Num > WorksheetFunction.Max(.Cells) Then
      MsgBox "So khong hop le": Exit Sub
    End If
    .Sort .Cells(1, 1), 1, Header:=xlYes
    .AutoFilter 1, Num
    .Offset(1).SpecialCells(12).ClearContents
    .AutoFilter 1, ">" & Num
    With Intersect(.Offset(1), .Cells).SpecialCells(12)
      .Value = Evaluate(.Address & "-1")
    End With
  End With
Thoat:
ActiveSheet.AutoFilterMode = False
End Sub
Hoàn toàn không có vòng lập nào, chỉ sort và AutoFilter thôi
 

File đính kèm

Upvote 0
Web KT

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

Back
Top Bottom