excel For Each未在工作簿的所有工作表上循环

fhity93d  于 2023-02-05  发布在  其他
关注(0)|答案(1)|浏览(128)

我希望清理文件夹中的多个Excel文件并重新调整其形状。我的Excel文件中每个文件至少有2个工作表。我的转换任务如下:
1.检查每个工作簿中是否有名称为"块"的工作表,如果有,则将其删除;
1.删除任何隐藏的图纸;
1.其他名称的图纸:
3.1.取消合并工作表中的所有单元格,
3.2.复制UsedRange的未合并单元格数据,
3.3.特殊粘贴/转置复制的数据到同一工作表最后使用的行下面,
3.4.删除复制UsedRange之前存在的原始数据,
3.5.删除从第4列开始的列,直到具有特定标题名称的列
我的问题是:
如果工作簿中有多个工作表的名称为"块"(需要删除)或有多个工作表具有不同的"块"名称(需要保留和转换),代码将停止在该工作簿上流动并中断。但是,如果我删除最后一个任务(上文3.5)从代码来看,它与最后一个任务进行得很顺利,甚至是一致的(3.5)如果一个工作簿中只有一个名称为"Block"的工作表和一个不同名称的工作表,它仍然完成了任务,所以,在我看来,可能是由于Lastcolumn变量的引用不正确,我不知道如何纠正它。我的VBA代码类似于:

Public Sub preparereports()
    Dim MyFSO As FileSystemObject
    Dim MyFolder As folder
    Dim MySubfolder As folder
    Dim wb As Object
    Dim ws As Worksheet

    Set MyFSO = New FileSystemObject
    folderPath = ThisWorkbook.Worksheets(1).Range("A2").Value
    Set folder = MyFSO.GetFolder(folderPath)

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .EnableEvents = False
        .AskToUpdateLinks = False
    End With

    For Each wb In folder.Files
        If Right(wb.Name, 3) = "xls" Or Right(wb.Name, 4) = "xlsx" Then
            Set masterWB = Workbooks.Open(wb)
            For Each ws In masterWB.Worksheets
                If Left(ws.Name, 5) = "Block" Or ws.Visible = xlSheetHidden Then
                    ws.Delete
                Else
                    ws.Cells.UnMerge
                    ws.Cells.ClearFormats
                    ws.UsedRange.Copy
                    Lastrow = ws.Cells(Rows.Count, "B").End(xlUp).Row + 1
                    ws.Range("A" & Lastrow).PasteSpecial Paste:=xlPasteValues, Transpose:=True
                    Application.CutCopyMode = False
                    ws.Range("A1" & ":A" & Lastrow).EntireRow.Delete
                    Lastcolumn = Application.WorksheetFunction.Match("Write offs", ws.Rows(1), 0)
                    ws.Range(Cells(, 5), Cells(, Lastcolumn - 1)).EntireColumn.Delete
                 End If
            Next ws
            ActiveWorkbook.Close True
        End If
    Next

    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
        .EnableEvents = True
        .AskToUpdateLinks = True
    End With
End Sub
kwvwclae

kwvwclae1#

由于您将Lastrow放置到.End(xlUp).row +1,因此您将删除ws.Range("A1 & :A" & Lastrow).EntireRow.Delete处的标题行,因此您复制粘贴了整个UsedRange,但再次删除了第一行。
那么最后一列可能找不到注销,因为这不能删除任何东西正确。
这是我在Lastcolumn中使用的代码:

lColumn = wsA.Cells(1, Columns.Count).End(xlToLeft).Column

当然,如果您想保留标题,请将行删除更改为:
ws.Range("A1 & :A" & Lastrow -1).EntireRow.Delete
如果有用就告诉我。

相关问题