Question

我正在寻找一个代码/宏来将一个文件夹位置（可能没有打开）的不同excel文件合并到一个excel中，其中多个工作表具有与各个excel名称相同的名称感谢

Answer 1

我通过搜索同样的问题找到了这些宏。大约有4种不同的。没有两个来自同一个来源。在编码时，如果你不能自己提出答案，它就会成为谷歌的益智游戏。

Sub GetSheets()
Dim temp As String
Dim name As String
Dim filename As String
Dim sheetName As String
Dim counter As Integer
Dim upper As Long
Dim myArray() As String

temp = Range("A2").Value
Path = StripFilename(temp)

On Error Resume Next
upper = UBound(myArray)
On Error GoTo 0

counter = 0
filename = Dir(Path & "*.xls")
Application.DisplayAlerts = False

Do While filename <> ""
    On Error Resume Next
    upper = UBound(myArray)
    On Error GoTo 0
    ReDim Preserve myArray(upper + 1)

    Workbooks.Open filename:=Path & filename, ReadOnly:=True
    sheetName = FileNameNoExt(filename)
    myArray(counter) = sheetName

    For Each sheet In ActiveWorkbook.Sheets
      If sheet.name = "Report" Then
          If Len(myArray(counter)) <= 31 Then
            sheet.name = myArray(counter)
          Else
            sheet.name = Left(myArray(counter), 31)
          End If
          sheet.copy After:=ThisWorkbook.Sheets(1)
      End If

    Next sheet

   Workbooks(filename).Close False

   filename = Dir()
   counter = counter + 1
 Loop

 Sheets(1).Select
 Application.DisplayAlerts = True 
End Sub

此函数从单元格A2获取指定文件路径中的文件。然后它检查工作表的名称并将其与＆＃34;报告＆＃34;进行比较，如果工作表名称为＆＃34;报告＆＃34;然后它复制（这是根据我需要的情况进行调整。你可以删除＆＃39; if＆＃39;语句并只复制）。这是你运行的主要子。以下函数只是main使用的辅助函数，用于帮助获取没有扩展名/路径/等的文件名。

`Function StripFilename(sPathFile As String) As String

'given a full path and file, strip the filename off the end and return the path
    Dim filesystem As New FileSystemObject
    StripFilename = filesystem.GetParentFolderName(sPathFile) & "\"

End Function

Function GetFilenameFromPath(ByVal strPath As String) As String
' Returns the rightmost characters of a string upto but not including the rightmost '\'

    If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
        GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
    End If
End Function

Function FileNameNoExt(strPath As String) As String
    Dim strTemp As String
    strTemp = Mid$(strPath, InStrRev(strPath, "\") + 1)
    FileNameNoExt = Left$(strTemp, InStrRev(strTemp, ".") - 1)
End Function`

将文件夹中的Excel与一个excel合并为多个工作表

1 个答案: