Question

我正在尝试构建一个打开文件夹中每个excel文件的例程，搜索（使用Find命令）查找字符串 “＃Issues”，选择找到字符串的整行，然后删除该行和接下来的两行。它在第一次迭代时成功运行，但第二次在查找命令的循环中失败。

我在第二次迭代中使用不同的代码多次努力解决这个问题，让我觉得我在定义我的对象时犯了一些错误。

我的代码：

Function CleanFilesInAGivenFolder(strFolder As String, _
         strCellLoc As String, _
         strNewValue As String)

Dim strReportType As String
Dim myfile
Dim mypath
Dim strPathFileName As String

If Right(strFolder, 1) <> "\" Then
   strFolder = strFolder & "\"
End If
mypath = strFolder
ChDir (strFolder)

myfile = Dir(mypath)
ChDir (mypath)
myfile = Dir("")

Do While myfile <> ""

        'Format the excel report
            strPathFileName = mypath & myfile

            Dim appExcel As Excel.Application
            Dim wkb As Excel.Workbook
            Dim sht As Worksheet
            Dim rng As Range
            Dim FoundCell As Range

          'Define the file and location
            strPathFileName = mypath & myfile

           'define the excel session
            Set appExcel = New Excel.Application
            appExcel.Visible = True

           'Define the workbook
            Set wkb = appExcel.Workbooks.Open(strPathFileName)
                          'Make sheet 1 the active sheet   
                          Set wkb = ActiveWorkbook
           Set sht = ActiveSheet


           'Find the row with "# Issues" in column A, 
           'delete row this next 2 rows
           'Only works the first iteration of loop


    With sht
         Set FoundCell = Selection.Find(What:="# Issues", _ 
         After:=[a1], 
         LookIn:=xlValues, _
         LookAt:=xlPart, _
         SearchOrder:=xlByRows, _
         SearchDirection:=xlNext, _
         MatchCase:=False, _
         SearchFormat:=False) 
         ActiveCell.EntireRow.Select
     End With


If Not FoundCell Is Nothing Then
    Selection.Delete Shift:=xlUp
    Selection.Delete Shift:=xlUp
    Selection.Delete Shift:=xlUp
End If
          'Clear Objects
            appExcel.DisplayAlerts = False
            wkb.Save
            wkb.Close
            appExcel.DisplayAlerts = True
            Set rng = Nothing
            Set sht = Nothing
            Set wkb = Nothing
            appExcel.Quit
            Set appExcel = Nothing

     myfile = Dir()

Loop
End Function

Answer 1

记住上面的一些评论：

Sub CleanFilesInAGivenFolder(strFolder As String)
    Dim FoundCell As Range
    Dim myFile As String
    Dim wkb As Workbook
    If Right(strFolder, 1) <> "\" Then
        strFolder = strFolder & "\"
    End If
    myFile = Dir(strFolder & "*.xlsx")
    Do While myFile <> ""
        Set wkb = Workbooks.Open(myFile)
        Do
            With Worksheets(1)
                Set FoundCell = .Cells.Find(What:="# Issues", _
                    After:=Range("A1"), _
                    LookIn:=xlFormulas, _
                    LookAt:=xlPart, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False, _
                    SearchFormat:=False)
            End With
            If Not FoundCell Is Nothing Then
                FoundCell.EntireRow.Resize(3).Delete
            Else
                Exit Do
            End If
        Loop
        wkb.Save
        wkb.Close
        myFile = Dir()
    Loop
End Sub

Answer 2

这是工作代码。我删除了select和active语句，并用.Cells.Find替换了Find语句中的Selection.Find

Function CleanFilesInAGivenFolder(strFolder As String, _
         strCellLoc As String, strNewValue As String)

Dim strReportType As String
Dim strCell As String
Dim strValue As String
Dim myfile
Dim mypath
Dim strPathFileName As String

strCell = strCellLoc
strValue = strNewValue

'if it needs a backslash on the end, add one
If Right(strFolder, 1) <> "\" Then
   strFolder = strFolder & "\"
End If

mypath = strFolder
ChDir (strFolder)

myfile = Dir(mypath)
ChDir (mypath)
myfile = Dir("")


Do While myfile <> ""

        'Format the excel report
            strPathFileName = mypath & myfile

            Dim appExcel As Excel.Application
            Dim wkb As Excel.Workbook
            Dim sht As Worksheet
            Dim rng As Range
            Dim FoundCell As Range

          'Define the file and location
            strPathFileName = mypath & myfile

           'define the excel session
            Set appExcel = New Excel.Application
            appExcel.Visible = True

           'Define the workbook
            Set wkb = appExcel.Workbooks.Open(strPathFileName)

Set sht = wkb.Sheets(1)
  With sht
     Set FoundCell = .Cells.Find(What:="# Issues", _
     After:=.Cells(1, 1), _
    LookIn:=xlFormulas, _
    LookAt:=xlPart, _
    SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, _
    MatchCase:=False, _
    SearchFormat:=False)

    If Not FoundCell Is Nothing Then
        FoundCell.Offset(2, 0).Delete Shift:=xlUp
        FoundCell.Offset(1, 0).Delete Shift:=xlUp
        FoundCell.Delete Shift:=xlUp
    End If
 End With
          'Clear Objects
            appExcel.DisplayAlerts = False
            wkb.Save
            wkb.Close
            appExcel.DisplayAlerts = True
            Set rng = Nothing
            Set sht = Nothing
            Set wkb = Nothing
            Set FoundCell = Nothing
            appExcel.Quit
            Set appExcel = Nothing
        myfile = Dir()
   Loop
   MsgBox "The Excel File Edits Are Completed", vbExclamation
End Function

第二次迭代时，Vba循环编辑Excel文件失败

2 个答案: