根據字符長度刪除行

嘗試刪除單元格少於2個字符的行。範圍（「A1」）線突出顯示，我不知道爲什麼。我可以運行它沒有線，並由於某種原因它刪除了一切。
任何建議非常感謝。下面的代碼：根據字符長度刪除行

Option Explicit 

Sub way() 

Dim cell As Range 

Range(「A1").CurrentRegion.activate 

For Each cell In Selection 

    If Len(cell) < 2 Then Selection.EntireRow.Delete 

Next cell 

End Sub

來源

2014-07-11 connor

你是什麼意味着你可以在沒有線的情況下運行它？沒有哪一行？ –

範圍（「A1」）線。 – connor

喬治，你是怎麼把代碼放在灰色的盒子裏的？謝謝 – connor

Sub way() 

Dim Cell As Range 
For Each Cell In Range("A1").CurrentRegion 
    If Len(Cell) < 2 Then Cell.EntireRow.Delete 
Next Cell 

End Sub

來源

2014-07-11 16:35:03 Tinbendr

試試這個

Sub mysub() 
    Dim r As Range 
    Dim i As Double 
    Dim rcount as Double 
    Dim mybool As Boolean 

    Set r = Range("A1").CurrentRegion 

    i = 1 
    mybool = False 

    Do 
     rcount = r.Rows.count 
     For j = 1 To r.Columns.count 
      If Len(Cells(i, j).Value) < 2 Then 
       Rows(i).Delete 
       If rcount = 1 then Exit Sub 
       mybool = True 
       Exit For 
      End If 
     Next j 
     If mybool = False Then i = i + 1 
     mybool = False 
    Loop While i <= rcount 

End Sub

編輯：只是爲了解釋爲何我產品總數這裏提供了一個新的代碼 - 原代碼背後的邏輯呢實際上是有缺陷。

例如考慮，如果你的範圍包括以下連續行

會發生什麼

 A  B  C  D  E 
1 ee e  eee ee eee 
2 f  fff fff ff ff

您的代碼將探索一行頂在每個電池行到下，由左到右。因此，在這個例子：

達到B1時，它會刪除行1和行2將被移動到第1行
，你的循環將單元格C1回暖 - 不是A1。換句話說，它將錯過探索單元格A1的值，該單元格應該符合刪除行的條件

來源

2014-07-11 18:36:17 IAmDranged

謝謝，在一排？ – connor

最初沒有想到在範圍最後刪除的所有行的情況下，範圍r不會與「Nothing」比較。這是什麼導致你正在涉及的問題。對此抱歉。我現在已經做了一些調整，以適應所有罰款 – IAmDranged

@IAmDranged正確的是，當您刪除一行時，下一行將向上移動併成爲當前行。 Next cell行然後將通過此行並移動到下一行，而不檢查是否有任何單元格的長度小於2個字符。

這裏的另一個方法是將離開Delete方法，直到少於2個字符後，將細胞已被發現：

Sub way() 

Dim cell As Range 
Dim deleteRange As Range 'This will be used to store the Cells found 

Range("A1").CurrentRegion.Activate 

For Each cell In Selection 

    If Len(cell) < 2 Then 

     If deleteRange Is Nothing Then 
      ' If this is the first cell found, then Set deleteRange to this cell 
      Set deleteRange = cell 
     Else 
      ' Any cells found after the first, we can use the 
      ' Union method to add it to the deleteRange 
      Set deleteRange = Application.Union(cell, deleteRange) 
     End If 

    End If 

Next cell 

' Once all cells have been found, then Delete 
deleteRange.Delete 

End Sub

來源

2014-07-12 12:31:30 Socii

謝謝你的幫助。爲什麼我不能用left（）函數使用此代碼，刪除以某個字符串開頭的東西？這就是我想：

子DeleteRow（）昏暗deleteRange作爲範圍昏暗的小區範圍昏暗請作爲字符串設置請= cell.Value 範圍（「A1」）CurrentRegion.Activate 對於每個小區選擇如果左（請，5）= 「對不起」然後如果deleteRange是Nothing然後設置deleteRange =細胞否則設置deleteRange = Application.Union（細胞，deleteRange）結束如果結束如果 NE XT細胞 deleteRange.delete 結束小組

– connor

'please'是一個字符串，所以你並不需要在'設置請= cell.Value'行'Set'聲明。試着將上面代碼中的If Len（cell）<2 Then'行改爲If If（cell）=「Sorry」，看看它是否適合你。 – Socii

您可以避免慢循環利用AutoFilter

此代碼

作品出當前區域的從A1
大小在下一欄增加了一個數組公式檢查每行中的所有單元格的長度，=MIN(LEN(A1:C1))<2
自動篩選刪除True結果

enter image description here

代碼

Sub NoLoops() 
Dim rng1 As Range 
Dim rng2 As Range 
Set rng1 = Range("A1").CurrentRegion 
Set rng2 = Range(Cells(1, rng1.Columns.Count + 1), Cells(rng1.Rows.Count, rng1.Columns.Count + 1)) 
ActiveSheet.AutoFilterMode = False 
With rng2 
    .Formula = "=MIN(LEN(RC[-" & rng1.Columns.Count & "]:RC[-1]))<2" 
    .FormulaArray = .FormulaR1C1 
    .Value = .Value 
    .AutoFilter Field:=1, Criteria1:="TRUE" 
    .EntireRow.Delete 
End With 
ActiveSheet.AutoFilterMode = False 
End Sub

來源

2014-07-12 12:56:44 brettdj

根據字符長度刪除行

回答

相關問題