Question

我正在编写一个宏，该宏将在文件夹中的所有Excel文件上运行，并使用某些标题复制列，然后粘贴到标题为＆＃34; ExtractedColumns＆＃34;）的新工作表中。

我在一个小文件夹（四个工作簿）上运行此宏，并成功将数据放到ExtractedColumns表上。

当我在包含60个文件的文件夹（包括我成功的样本集中的四个文件）上运行宏时，它跳过了一些工作簿，似乎已经自行包装了。最后一个文件的提取列出现在开头，而前几个文件中的列（包括之前成功运行的样本列）并未显示。

我认为问题是迭代文件夹的代码。

Sub AllFiles()
Dim folderPath As String
Dim filename As String
Dim wb As Workbook

folderPath = 'I put the path name here

If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"

filename = Dir(folderPath & "*.xls")
Do While filename <> ""
    Application.ScreenUpdating = False
    Set wb = Workbooks.Open(folderPath & filename)

    'Macro from below goes here

    Workbooks("ExtractedColumns").Worksheets("Sheet1").Cells(n, 1).Value = filename
    wb.Close
    filename = Dir
Loop
Application.ScreenUpdating = True
End Sub

这是完整的宏：

Dim curr As Range
Dim cell As Range
Dim lastRow As Variant
Dim n As Long
Dim found As Boolean
Dim FirstRow As Range

found = False

For i = 3 To 30
    If Not IsEmpty(Cells(i, "C")) Then
        Exit For
    End If
Next

For Each curr In Range("A" & i, "Z" & i)
    If InStr(1, curr.Value, "Protein name", vbTextCompare) > 0 Or InStr(1, curr.Value, "description", vbTextCompare) > 0 Or InStr(1, curr.Value, "Common name", vbTextCompare) > 0 Then
        Range(curr.Offset(1), Cells(Rows.Count, curr.Column).End(xlUp)).Copy Destination:=Workbooks("ExtractedColumns (version 2)").Sheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Offset(1, 0)
        found = True
        Exit For
    End If
Next

If Not found Then
    For Each curr In Range("A" & i, "Z" & i)
        If InStr(1, curr.Value, "protein", vbTextCompare) > 0 Then
            Range(curr.Offset(1), Cells(Rows.Count, curr.Column).End(xlUp)).Copy Destination:=Workbooks("ExtractedColumns").Sheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Offset(1, 0)
            Exit For
        End If
    Next              
End If

For Each curr In Range("A" & i, "Z" & i)
    If InStr(1, curr.Value, "accession", vbTextCompare) > 0 Or InStr(1, curr.Value, "Uniprot", vbTextCompare) > 0 Or InStr(1, curr.Value, "IPI") > 0 Then
        Range(curr.Offset(1), Cells(Rows.Count, curr.Column).End(xlUp)).Copy Destination:=Workbooks("ExtractedColumns").Sheets("Sheet1").Cells(Rows.Count, "E").End(xlUp).Offset(1, 0)
        found = True
        Exit For
    End If
Next

For Each curr In Range("A" & i, "Z" & i)
    If (InStr(1, curr.Value, "residue", vbTextCompare) > 0 Or curr.Value = "Position" Or curr.Value = "Positions" Or InStr(1, curr.Value, "Site", vbTextCompare) > 0) And Not InStr(1, curr.Value, "ERK") > 0 Then
        Range(curr.Offset(1), Cells(Rows.Count, curr.Column).End(xlUp)).Copy Destination:=Workbooks("ExtractedColumns").Sheets("Sheet1").Cells(Rows.Count, "G").End(xlUp).Offset(1, 0)
        Exit For
    End If
Next

'puts dashes in any blank cells in the columns
n = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
For Each curr In Workbooks("ExtractedColumns").Sheets("Sheet1").Range("D2:D" & n)
    If curr.Value = "" Then curr.Value = " - "
Next
For Each curr In Workbooks("ExtractedColumns").Sheets("Sheet1").Range("E2:E" & n)
    If curr.Value = "" Then curr.Value = " - "
Next
For Each curr In Workbooks("ExtractedColumns").Sheets("Sheet1").Range("G2:G" & n)
    If curr.Value = "" Then curr.Value = " - "
Next

Answer 1

您应该通过提供正在处理的工作表来清理代码。

set ws = wb.Sheets(1)
with ws
    For Each curr In .Range("A" & i, "Z" & i)
        If InStr(1, curr.Value, "Protein name", vbTextCompare) > 0 Or InStr(1, curr.Value, "description", vbTextCompare) > 0 Or InStr(1, curr.Value, "Common name", vbTextCompare) > 0 Then
            .Range(curr.Offset(1), .Cells(.Rows.Count, curr.Column).End(xlUp)).Copy Destination:=Workbooks("ExtractedColumns (version 2)").Sheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Offset(1, 0)
            found = True
            Exit For
        End If
    Next
end with

我永远不会使用ActiveSheet。

n = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row

试试这个

lastRow = ws.Cells(ws.Rows.Count,"D").End(xlUp).Row

我希望这有帮助。我无法在我的机器上测试它，因为我没有安装Excel。

如何在文件夹中的所有文件上运行宏？

1 个答案: