Question

我在同一版面中有多个工作簿。在电池＆＃34; I8＆＃34;我已经计算了一个我想从所有工作簿中编译的特定值。

以下是我的代码示例：

Sub Code()

    Dim file As String
    Dim wbResults As Workbook
    Dim myPath As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    myPath = "C:\Test\"

    file = Dir$(myPath & "*.xls*")

    While (Len(file) > 0)
        Set wbResults = Workbooks.Open(Filename:=myPath & file, UpdateLinks:=0)

        With wbResults.Worksheets(Split(file, ".")(0))

        With .Range("I8")
            .Formula = "=10^(D28+(I7*I2))"
        End With  

        End With

        wbResults.Close SaveChanges:=True
        file = Dir
    Wend

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

我想添加到此代码并在另一个excel工作簿中编译列表，其中列A放置工作簿文件的名称，列B放置＆＃34; I8＆＃34;在那个工作手册中。

Answer 1

以下是我的回答：

Sub Code()

    Dim file As String
    Dim wbResults As Workbook
    Dim myPath As String
    myPath = "C:\Test\"

    '---------------- Create a new workbook then save it ----------------
    Dim WBSummary As Workbook
    Set WBSummary = Excel.Application.Workbooks.Add
    WBSummary.SaveAs myPath & "WBSummary.xls"
    '--------------------------------------------------------------------

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    file = Dir$(myPath & "*.xls*")

    Dim i As Long 'To update row number in WBSummary
    While (Len(file) > 0)
        i = i + 1

        If file <> "WBSummary.xls" Then
            Set wbResults = Workbooks.Open(Filename:=myPath & file, UpdateLinks:=0)

            With wbResults.Worksheets(Split(file, ".")(0))

                With .Range("I8")
                    .Formula = "=10^(D28+(I7*I2))"

                    .Calculate 'To update value in "I8"
                    WBSummary.Worksheets(1).Cells(i, 1).Value = file
                    WBSummary.Worksheets(1).Cells(i, 2).Value = .Value
                End With

            End With

            wbResults.Close SaveChanges:=True
        End If

        file = Dir
    Wend

    WBSummary.Close True 'Close and Save WBSummary

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

使用VBA编译多个工作簿中特定单元的列表/摘要？

1 个答案: