Question

所以，我没有编码经验，我从未学习过编码，但是我在这里可以偶然接触到这段代码，我只想添加一个if语句来制作它，这样我就可以过滤掉任何不包含某些文本的文档在字段A1中。我该怎么做呢？

Sub MergeExcelFiles()
    Dim fnameList, fnameCurFile As Variant
    Dim countFiles, countSheets As Integer
    Dim wksCurSheet As Worksheet
    Dim wbkCurBook, wbkSrcBook As Workbook

    fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)

    If (vbBoolean <> VarType(fnameList)) Then
        If (UBound(fnameList) > 0) Then
            countFiles = 0
            countSheets = 0

            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual

            Set wbkCurBook = ActiveWorkbook

            For Each fnameCurFile In fnameList
                countFiles = countFiles + 1
                Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)

                For Each wksCurSheet In wbkSrcBook.Sheets
                    countSheets = countSheets + 1
                    wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
                Next
                wbkSrcBook.Close SaveChanges:=False
            Next

            Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic

            MsgBox "Procesed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
        End If
    Else
        MsgBox "No files selected", Title:="Merge Excel files"
    End If
End Sub

Answer 1

这应该起作用-确保将此处的文本替换为您希望在A1中显示的文本。

Sub MergeExcelFiles()
    Dim fnameList, fnameCurFile As Variant
    Dim countFiles, countSheets As Integer
    Dim wksCurSheet As Worksheet
    Dim wbkCurBook, wbkSrcBook As Workbook

    fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)

    If (vbBoolean <> VarType(fnameList)) Then

        If (UBound(fnameList) > 0) Then
            countFiles = 0
            countSheets = 0

            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual

            Set wbkCurBook = ActiveWorkbook

            For Each fnameCurFile In fnameList
                countFiles = countFiles + 1
                Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)

                For Each wksCurSheet In wbkSrcBook.Sheets
                    countSheets = countSheets + 1

                    If wksCurSheet.Range("A1").Value = "Your text here" Then

                        wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)

                    End If

                Next
                wbkSrcBook.Close SaveChanges:=False
            Next

            Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic

            MsgBox "Procesed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
        End If
    Else
        MsgBox "No files selected", Title:="Merge Excel files"
    End If
End Sub

Answer 2

这样做：

For Each wksCurSheet In wbkSrcBook.Sheets
     If wksCurSheet.Range("A1").Value = "CopyThisOneToo" Then
         countSheets = countSheets + 1
         wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
     Else
         countSkippedSheets = countSkippedSheets + 1
     End If
Next

根据需要更改"CopyThisOneToo"。对于部分匹配，您可以使用InStr或Left或Right，例如

If Left(wksCurSheet.Range("A1").Value, 6) = "Report" Then ....

您将需要声明和初始化countSkippedSheets，并将其包含在最终状态打印输出中。

Answer 3

尝试一下：

Sub MergeExcelFiles()
    Dim fnameList As Variant, fnameCurFile As Variant
    Dim countFiles As Integer, countSheets As Integer
    Dim wksCurSheet As Worksheet
    Dim wbkCurBook As Workbook, wbkSrcBook As Workbook

    fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)

    If vbBoolean <> VarType(fnameList) Then
        If UBound(fnameList) > 0 Then
            countFiles = 0
            countSheets = 0

            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual

            Set wbkCurBook = ActiveWorkbook

            For Each fnameCurFile In fnameList
                countFiles = countFiles + 1
                Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)
                For Each wksCurSheet In wbkSrcBook.Sheets
                    If wksCurSheet.Range("A1").Value = "foo" Then
                        countSheets = countSheets + 1
                        wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
                    End If
                Next
                wbkSrcBook.Close SaveChanges:=False
            Next

            Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic

            MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
        End If
    Else
        MsgBox "No files selected", Title:="Merge Excel files"
    End If
End Sub

也请注意对变量声明所做的更改。

Excel合并文档宏

3 个答案: