Невозможно пропустить определенные столбцы при очистке содержимого

Question

Я пытаюсь создать скрипт в vba для удаления нежелательного содержимого, такого как @, которое не попадает под определенные столбцы, как в 5,8,11 и т. Д. До 20. Однако, если содержание какоеЯ хочу, чтобы избавиться от этих столбцов, пусть они как есть.

Я пытался до сих пор (не могу найти ни одной идеи пропустить вышеупомянутые столбцы):

Sub SkipColumns()
    Dim Ws As Worksheet
    Dim cel As Range, I&

    Set Ws = ThisWorkbook.Sheets("Sheet1")

    For I = 3 To 20
        For Each cel In Ws.Range("A2:A" & Ws.Cells(Rows.Count, 1).End(xlUp).row)
            If InStr(cel(1, I), "@") > 0 Then
                cel(1, I).ClearContents
            End If
        Next cel
    Next I
End Sub

Посмотрите на изображение ниже, где должны быть затененные столбцы, даже если они имеют знаки @.

Какое условие я должен определить в сценарии для достижения этого?

Answer 1

вы можете пойти так:

Sub SkipColumns()
    With ThisWorkbook.Sheets("Sheet1")
        .Range("E1,H1,K1,N1,Q1,T1,W1").EntireColumn.Hidden = True 'hide columns you don't want to skip
        .UsedRange.SpecialCells(xlCellTypeVisible).Replace what:="@", replacement:="", lookat:=xlWhole ' replace in visible cells only
        .Range("E1,H1,K1,N1,Q1,T1,W1").EntireColumn.Hidden = False ' get hidden columns back visible
    End With
End Sub

Answer 2

Если вы хотите жестко указать пропущенные столбцы, вы можете использовать Case Select

Sub SkipColumns()
    Dim ws As Worksheet
    Dim Cell As Range, i As Long, LastRow As Long

    Set ws = ThisWorkbook.Sheets("Sheet1")
    LastRow = ws.Cells.SpecialCells(xlCellTypeLastCell).Row

    For i = 3 To 20
        Select Case i
            Case 5, 8, 11, 14, 17, 20
            Case Else
                For Each Cell In ws.Range(Cells(2, i), Cells(LastRow, i))
                    If InStr(Cell, "@") > 0 Then Cell.ClearContents
                Next Cell
        End Select
    Next i
End Sub

Answer 3

Поскольку интервал является регулярным, вы можете проверить его в цикле

, например:

if Not (I - 2) Mod 3 = 0 Then
   'your find, delete code
End if

Но вы можете найти метод Replace быстрее:

  Dim WS As Worksheet
  Dim R As Range
  Dim LR As Long
  Dim i As Long


Set WS = ThisWorkbook.Worksheets("Sheet1") 'change to suit
With WS
    LR = .Cells(.Rows.Count, 1).End(xlUp).Row 
    'your code looks for last row in Column A, but you could use a different method, or even whole column

'Create a range of all the rows to process
    Set R = .Range(.Cells(2, 3), .Cells(LR, 4))
    For i = 6 To 20 Step 3
        Set R = Union(R, .Range(.Cells(2, i), .Cells(LR, i + 1)))
    Next i
End With

R.Replace What:="@", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows

Answer 4

Набор команд For..Next позволяет пропускать через равные промежутки времени с Step. Попробуйте это:

Set Ws = ThisWorkbook.Sheets("Sheet1")

For I = 3 To 20 Step 3
    With Ws
        For Each cel In .Range(.Cells(2, I), .Cells(.Cells(.Rows.Count, I).End(xlUp).Row, I+1))
            If InStr(cel.Value, "@") > 0 Then
                cel.ClearContents
            End If
        Next cel
    End With
Next I

Answer 5

Я не до конца понимаю ваш вопрос, возможно вы ошиблись уровнем цикла.

For Each cel In Ws.Range("A2:A" & Ws.Cells(Rows.Count, 1).End(xlUp).row)
   j=cel.row
   del_YESNO=False
   For I = 3 To 20
      If InStr(cel(j, I), "@") > 0 Then
          del_YESNO=True
          exit for
      End If
   Next I
   if del_YESNO=True then cel(j, I).ClearContents
Next cel