【问题标题】:Excel VBA loop folder and check if Excel file name is equal to worksheetExcel VBA循环文件夹并检查Excel文件名是否等于工作表
【发布时间】:2017-07-09 19:44:37
【问题描述】:

我需要一些启发。 我正在尝试将 Excel 文件的文件夹与 Excel 工作簿中的一些工作表相匹配。到目前为止,我能够读取这些 Excel 文件名和相应的工作表并将它们复制到我的工作簿的sheet1B1。之后,我为每个文件创建一个工作表。

我希望宏继续并将目录中的每个文件与我在工作簿中的工作表进行比较。如果工作簿中的工作表名称等于文件名,则复制文件内容(这些文件中只有 sheet1 有数据)。

这是我目前所拥有的:

Sub readme()

Dim directory As String, fileName As String, sheet As Worksheet, i As Integer, j As Integer

Application.ScreenUpdating = False
directory = "D:\Claro Chile\Report_sem_formulas\"
fileName = Dir(directory & "*.xl??")

        Do While fileName <> ""

             i = i + 1
             j = 2
             Cells(i, 1) = fileName
             Workbooks.Open (directory & fileName)

                    For Each sheet In Workbooks(fileName).Worksheets

                    Workbooks("Report Status v1.xlsm").Worksheets(1).Cells(i, j).Value = sheet.Name

                    j = j + 1

        Next sheet

    Workbooks(fileName).Close
    fileName = Dir()

Loop

Application.ScreenUpdating = True
Call create_sheets_starting_from_B1

End Sub

Sub create_sheets_starting_from_B1()

Dim MyCell As Range, MyRange As Range

Set MyRange = Sheets("Summary").Range("B1")
Set MyRange = Range(MyRange, MyRange.End(xlDown))

    For Each MyCell In MyRange
        Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
        Sheets(Sheets.Count).Name = MyCell.Value 'renames the new worksheet
    Next MyCell

Sheets("Summary").Move Before:=Sheets(1)

End Sub

【问题讨论】:

  • 谢谢 Peh,下次会改进!

标签: vba excel


【解决方案1】:

未经测试!

但你可能需要类似的东西:

Sub sheetCompare()
    Dim i As Integer
    Dim mDirs As String
    Dim path As String
    Dim OutFile As Variant, SrcFile As Variant
    Dim file As Variant

    OutFile = ActiveWorkbook.Name
    mDirs = "c:\" 'your dir here
    file = Dir(mDirs)
    While (file <> "")
        path = mDirs + file
        Workbooks.Open (path)
        SrcFile = ActiveWorkbook.Name

        For i = 1 To Workbooks(OutFile).Sheets.Count
            If file = Workbooks(OutFile).Sheets(i).Name Then
                'copy logic
            End If
        Next i
        Workbooks(file).Close (False)
        file = Dir
    Wend
End Sub

【讨论】:

  • 也许我做错了什么,但我得到了一个永远结束的循环:D。
  • 对不起,这是我的错误。我忘了进入下一个文件。看最后两行
  • 不知道如何执行复制逻辑...在我的脑海中,但似乎无法弄清楚如何去做
  • 录制宏,复制和粘贴内容,修改代码以考虑工作表名称和复制范围。
  • 知道了:使用复制逻辑更新了代码。 @tretom 感谢您的帮助!!
猜你喜欢
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2016-12-23
  • 1970-01-01
  • 1970-01-01
  • 2015-08-02
相关资源
最近更新 更多