我试图删除不包含新单词的行。
我做了什么:
问题: 当宏删除一行时,它应该使用"下一个单元格"进入下一行,但它会跳过一行。
我需要你的帮助,因为我不知道如何让它在VBA中工作(这里是新手)。 如何防止跳过并处理选择中的每一行?
演示数据:
A B
A B C
C B
A C
A B F
我的结果:
A B
A B C
A C
A B F
应该是:
A B
A B C
A B F
代码:
Sub clean_keys()
' unique words
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
For Each cell In Selection
Dim strArray() As String
Dim intCount As Integer
strArray = Split(cell.Value, " ")
Dim intWords As Integer
intWords = 0
For intCount = LBound(strArray) To UBound(strArray)
If dict.Exists(Trim(strArray(intCount))) Then
dict(Trim(strArray(intCount))) = dict(Trim(strArray(intCount))) + 1
Else
dict.Add Key:=Trim(strArray(intCount)), Item:=1
intWords = intWords + 1
End If
Next
If intWords = 0 Then
cell.EntireRow.Delete
End If
Next cell
End Sub
答案 0 :(得分:2)
删除行时始终从底部运行到顶部,否则您可能会跳过行(正如您所注意到的那样)。
'don't dim inside a loop
Dim r As Long
Dim strArray As Variant
Dim intCount As Integer
Dim intWords As Integer
With Selection
For r = .Rows.Count To 1 Step -1
strArray = Split(Selection.Cells(r).Value & " ", " ")
intWords = 0
For intCount = LBound(strArray) To UBound(strArray) - 1
If dict.Exists(Trim(strArray(intCount))) Then
dict(Trim(strArray(intCount))) = dict(Trim(strArray(intCount))) + 1
Else
dict.Add Key:=Trim(strArray(intCount)), Item:=1
intWords = intWords + 1
End If
Next intCount
If intWords = 0 Then
.Cells(r).EntireRow.Delete
End If
Next r
End With