为我的新生事道歉,但我遇到了一些关于我制作的excel vba代码的问题。它旨在清理包含数百个条目的Excel工作表。
格式始终相同,列D,E和F有时在所有三个中都有相同的单词(单词purge)。在这种情况下,我希望删除该行。
我试图将我的范围定义为D,并使用.Find功能搜索我的问题。然后从那里偏移查找偏移量查找。
唉,我的程序已经转变为告诉我我编码错误只是简单地运行(冻结)而没有结果。我会发布我的代码,以便我的情况可能更清楚。P.S。 如果有人可以帮我修改我的代码,并解释我做错了什么以及为什么,那将非常感谢!
谢谢大家!
Sub DeleteRows()
Dim strPath As String
Dim strFile As String
Dim wbk As Workbook
Dim wsh As Worksheet
Dim strFind As String
Dim SrchRng
Dim x As Range
Dim y
Dim z
'searches directory for any and all excel files
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then
strPath = .SelectedItems(1)
Else
MsgBox "No folder selected!", vbExclamation
Exit Sub
End If
End With
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
Application.ScreenUpdating = False
strFile = Dir(strPath & "*.xls*")
Do While strFile <> ""
Set wbk = Workbooks.Open(Filename:=strPath & strFile, AddToMRU:=False)
For Each wsh In wbk.Worksheets
'end directory search
'supposed to search column d, offset column +1 in same row,
'then do same for a third row.
'if all three cells contain "PURGE" then delete cell
Set SrchRng = ActiveSheet.Range("D1",
ActiveSheet.Range("D65536").End(xlUp))
Do
Set x = SrchRng.Find("PURGE", LookIn:=xlValues)
Set y = ActiveCell.Offset(0, 1).Find("PURGE", LookIn:=xlValues)
Set z = ActiveCell.Offset(0, 2).Find("PURGE", LookIn:=xlValues)
If Not x Is Nothing And Not y Is Nothing And Not z Is Nothing Then x.EntireRow.Delete
Loop While Not x Is Nothing
Next
For Each wsh In wbk.Worksheets
Next wsh
wbk.Close SaveChanges:=True
strFile = Dir
Application.ScreenUpdating = True
End Sub
答案 0 :(得分:0)
我会亲自在excel中编写公式,以确定是否需要删除行。 (该行的任何列都包含您要查找的单词)。一旦我知道公式正常工作,我会在最后一栏中使用vba将其添加到文件中。
在最后一列中的公式后,我会对此行进行排序并删除我需要的任何行。然后删除新列并保存文件。
答案 1 :(得分:0)
看看这个。这使用了FindNext
和Offset
(不完全确定为什么要在一个单元格上使用Find
)这会找到值PURGE
,如果它旁边的两个单元格是还PURGE
然后删除该行。如果没有继续下去。
此行Do While strFile <> ""
在某些时候需要Loop
,但不确定您想要的位置。
Option Explicit
Sub DeleteRows()
Dim wbk As Workbook
Dim wsh As Worksheet
Dim strPath As String, strFile As String, strFind As String, firstAddress As String
Dim x As Range, y As Range, z As Range
Dim DelRng As Range
'searches directory for any and all excel files
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then
strPath = .SelectedItems(1)
Else
MsgBox "No folder selected!", vbExclamation
Exit Sub
End If
End With
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
With Application
.ScreenUpdating = False
' Stops xlsm files on Open event
.EnableEvents = False
' uncomment to hide any deletion message boxes
' .DisplayAlerts = False
End With
strFile = Dir(strPath & "*.xls*")
Do While Len(strFile) > 0
Set wbk = Workbooks.Open(Filename:=strPath & strFile, AddToMRU:=False)
For Each wsh In wbk.Worksheets
'end directory search
'supposed to search column d, offset column +1 in same row,
'then do same for a third row.
'if all three cells contain "PURGE" then delete cell
With wsh.Columns(4)
Set x = .Find("PURGE", Lookat:=xlPart)
If Not x Is Nothing Then
firstAddress = x.Address
Do
If InStr(1, x.Offset(0, 1), "purge", vbTextCompare) > 0 And InStr(1, x.Offset(0, 2), "purge", vbTextCompare) > 0 Then
If DelRng Is Nothing Then
Set DelRng = x
Else
Set DelRng = Union(DelRng, x)
End If
End If
Set x = .FindNext(x)
Loop While Not x Is Nothing And x.Address <> firstAddress
End If
End With
Next wsh
If Not DelRng Is Nothing Then DelRng.EntireRow.Delete
wbk.Close SaveChanges:=True
strFile = Dir()
Loop
With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub