Question

我的Excel摘要表（您可以想象行和列是如何...）

No   Drawing  AnnualQuantity    RawMatCost  TotalPrice     Turnover 
 1     4050          80000           1.23        3.52        281600
 2     2993          20000           0.44        2.20        44000
 3     8544          34000           1.37        2.87        97500

按钮＆＃34;获取信息：＆＃34;

这是我的问题...... 下面是我正在讨论的我的优秀表，我有很多analiysis excel文件。每个都有近10-15张表格。表单使用的数据库位于每个excel文件的前5页。我需要创建一个摘要。从每个工作表中获取必填字段（在第5页之后）并将它们复制到新工作表中，然后将该行复制到我的工作excel文件中，或者如果所选字段可以在＃34之前添加到行中，则更好;总和＆＃34 34;为每张纸插入新行

＆＃39;这是我的范围

ShName = "??" 'All sheets after 5th sheet in the workbook
Set Rng = Range("E3,I3,V12,AC39") 'need to copy these fields from all sheets

＆＃39;我可以使用此命令选择具有多重选择的文件。

FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xl*", _
                                          MultiSelect:=True)

Answer 1

圣诞假期不是期待快速回答问题的好时机，因为大多数回答者都来自美国或欧洲，并且会忙于他们的家人。

您的问题包括可能与您的解决方案相关的声明，但您没有表明您曾试图将这些声明链接到工作宏。你也没有说明你知道什么。你知道如何遍历工作簿列表吗？你知道如何遍历工作簿的所有工作表吗？您没有说明如何使用此宏。您是要添加现有摘要还是创建新摘要？这个宏可以使用一次，每月一次，每周一次还是每天一次？使用频率将显着影响宏的最佳设计。

这个网站存在让程序员互相帮助发展;它不是免费的编码服务。即使有人愿意为你编写宏，你的规范也太模糊了，不允许他们这样做。

这个答案试图让你开始。

你说你有很多分析Excel工作簿。如果您的宏只使用一次，或者每次都要选择完全不同的工作簿集，GetOpenFilename可能是合适的。但是，这种方法很难选择许多文件，特别是如果你必须经常使用它。

对这些问题中的任何一个问题都可以回答“是”吗？

是否所有分析工作簿都在一个文件夹中？
是否可以将所有分析工作簿移动到单个文件夹中？
可以创建一个文件夹列表，其中每个工作簿都是分析工作簿吗？
您是否可以创建要汇总的工作簿的完整列表？

如果你对问题1或2回答“是”，那么宏Approach1可能会给你一个开始。此宏创建一个文件，其中包含与包含宏的工作簿相同的文件夹中的所有工作簿的名称，但包含宏的工作簿除外。

这个宏有两个目的。首先，它显示了一种可能满足您的第一个要求的技术：找到所有分析文件。其次，它展示了当你不确定如何编写宏时如何开发宏。在考虑打开工作簿并将所选数据复制到摘要工作表之前，必须找到所需的工作簿。运行宏并查看“Test.txt”的内容。它是否包含每个分析文件的列表而没有其他文件？如果是，您已完成宏的第一步。如果没有，则需要进一步开发宏。例如，您可以调整文件规范以获取所需的列表吗？

如果你对问题1或2不能回答“是”，那么宏Approach2可能是一个更好的起点。这里有一个名为“目标文件”的工作表，其中列出了文件夹和文件规范：

Example of worksheet Target Files

此路径和文件规范来自我的笔记本电脑，但显示了您可以进行的文件选择。 C列中的文字是评论。在A列和B列中，我有文件夹和文件规范。当我想要拾取分散在多个文件夹中的文件时，这是一种我觉得很方便的技术。我再次将找到的文件输出到“Text.txt”。但是，这次有错误消息，例如“文件夹不存在”。您需要调整列表，直到没有错误并列出每个分析文件。

这两个宏应该为您提供第一步的想法。如果两者都不正确，请尝试调整最接近的那个，或者将它们用作宏的想法来源。或者，也许每次运行宏都会处理不同的文件列表，GetOpenFilename是一种更好的方法。编写一个使用GetOpenFilename获取文件名的宏，并将这些名称输出到文本文件中。如果您遇到困难，请回复您的错误代码并明确说明哪些不起作用。这是一种可以在这里快速回答的问题。

一旦宏列出了正确的分析文件，您就可以为接下来的步骤做好准备了。我建议您的宏的第二个版本打开并关闭每个分析文件。对于第三个版本，我建议列出您希望从中提取数据的工作表的名称。

一次一步地开发宏比尝试一次完成所有内容要容易得多。

Option Explicit
Sub Approach1()

  ' This macro assumes all analysis workbooks are in the same
  ' folder as the workbook containing this macro.

  Dim FileName As String
  Dim FileObj As Object
  Dim FileSysObj As Object
  Dim Path As String
  Dim WbkThis As Workbook

  Set WbkThis = ThisWorkbook        ' The workbook containing this macro

  Path = WbkThis.Path

  Set FileSysObj = CreateObject("Scripting.FileSystemObject")
  ' True means overwrite existing file with same name
  Set FileObj = FileSysObj.CreateTextFile(Path & "\Test.txt", True)

  FileName = Dir$(Path & "\*.xl*")

  Do While FileName <> "" And FileName <> WbkThis.Name
    Call FileObj.WriteLine(FileName)
    FileName = Dir$
  Loop

  FileObj.Close

End Sub
Sub Approach2()

  ' This macro uses the worksheet Target Files to
  ' specify the required analysis workbooks.

  Const ColTgtPath As Long = 1
  Const ColTgtFile As Long = 2

  Dim AtLeastOneMatchingFileFound As Boolean
  Dim FileName As String
  Dim FileObj As Object
  Dim FileSpec As String
  Dim FileSysObj As Object
  Dim Path As String
  Dim RowTgtCrnt As Long
  Dim WbkThis As Workbook

  Set WbkThis = ThisWorkbook        ' The workbook containing this macro

  Set FileSysObj = CreateObject("Scripting.FileSystemObject")
  ' True means overwrite existing file with same name
  Set FileObj = FileSysObj.CreateTextFile(WbkThis.Path & "\Test.txt", True)

  RowTgtCrnt = 2
  Path = ""

  Do While True
    With WbkThis
      With .Worksheets("Target Files")
        If .Cells(RowTgtCrnt, ColTgtFile).Value = "" Then
          ' No file name so end of list
          Exit Do
        End If
        FileSpec = .Cells(RowTgtCrnt, ColTgtFile).Value
        If .Cells(RowTgtCrnt, ColTgtPath).Value <> "" Then
          Path = .Cells(RowTgtCrnt, ColTgtPath).Value
          If Right(Path, 1) <> "\" Then
            ' Ensure path ends in "\"
            Path = Path & "\"
          End If
        End If
      End With
    End With

    If FileSysObj.FolderExists(Path) Then
      ' Have existing folder
      FileName = Dir$(Path & FileSpec)
      If FileName = "" Then
        Call FileObj.WriteLine("No files matching specification " & _
                               FileSpec & " found in folder " & Path)
        AtLeastOneMatchingFileFound = False
      ElseIf FileName = WbkThis.Name And Path = WbkThis.Path & "\" Then
        ' This workbook is the workbook containing this
        ' macro which cannot be an analysis file.
        ' Try for another matching file
        FileName = Dir$
        If FileName = "" Then
          Call FileObj.WriteLine("No files matching specification " & _
                                 FileSpec & " other than " & WbkThis.Name & _
                                 " found in folder " & Path)
          AtLeastOneMatchingFileFound = False
        Else
          ' A matching file other than workbook containing macro found
          AtLeastOneMatchingFileFound = True
        End If
      Else
        ' At least one acceptable file within folder matches specification
        AtLeastOneMatchingFileFound = True
      End If
      If AtLeastOneMatchingFileFound Then
        Do While FileName <> ""
          Call FileObj.WriteLine(Path & FileName)
          FileName = Dir$
        Loop
      End If
    Else
      Call FileObj.WriteLine("Folder " & Path & " does not exist")
    End If

    RowTgtCrnt = RowTgtCrnt + 1

  Loop

  FileObj.Close

End Sub

将所选工作簿的所有工作表复制到工作表

1 个答案: