vba Excel：使用其他工作表中的某些单元格创建汇总工作表

Excel: Create summary worksheet using certain cells from other worksheets

提问by Swiftslide

I have a whole bunch of tabs which share a standard structure. In cells A1, B1, C1 of each tab, I have, respectively, an ID number, a first Name and a surname. There is a whole bunch of other information on each tab that is not relevant to the question.

我有一大堆共享标准结构的选项卡。在每个选项卡的单元格 A1、B1、C1 中，我分别有一个 ID 号、一个名字和一个姓氏。每个选项卡上还有一大堆与问题无关的其他信息。

I want to create a summary tab, with a 3-column table carrying only the ID number, first name and surname from each of the other tabs. Again, these are always in cells A1, B1, C1. I also want the id number in the summary table to hyperlink to the appropriate tab.

我想创建一个摘要选项卡，其中包含一个 3 列表，其中仅包含来自其他每个选项卡的 ID 号、名字和姓氏。同样，这些始终位于单元格 A1、B1、C1 中。我还希望汇总表中的 id 号超链接到相应的选项卡。

Is there any way to semi-automate this using cell references? Like how, in a single table, if you enter a number in a cell and drag downwards, the number will be incremented in each consecutive cell in the column. Is there any way to achieve a similar effect, but with the cell reference remaining constant (always cell A1, A2, A3) and the TAB reference being incremented? In short, is there any way to tie a particular row to a separate tab (in a way that will take care of the hyperlinking, also)? Or do I have to enter the reference manually for each table?

有没有办法使用单元格引用来半自动化？就像在单个表格中，如果您在单元格中输入一个数字并向下拖动，则该列中每个连续单元格中的数字都会增加。有什么方法可以达到类似的效果，但单元格引用保持不变（总是单元格 A1、A2、A3）并且 TAB 引用增加？简而言之，有没有办法将特定行绑定到单独的选项卡（以某种方式也可以处理超链接）？还是我必须为每个表手动输入参考？

Not that the tabs are not labelled Sheet 1, Sheet 2 etc. They will be labelled with the name of the person whose information they hold.

并不是说这些标签没有标记为 Sheet 1、Sheet 2 等。它们将标有其持有信息的人的姓名。

回答by brettdj

[EDIT: Added ASAP option]

[EDIT: Added ASAP option]

ASAP utilities takes the hard work out of this

ASAP 实用程序解决了这个问题

• Download ASAP utilities , http://www.asap-utilities.com/
• Run the utility as per screenshot 1 below
• Chose whether you want a live link summary, or hardcoded report (screenshot 2)

• 下载 ASAP 实用程序，http://www.asap-utilities.com/
• 按照下面的屏幕截图 1 运行该实用程序
• 选择您想要实时链接摘要还是硬编码报告（屏幕截图 2）

ASAP settings

尽快设置

Select your A1:C1 accross sheets

选择您的 A1:C1 跨工作表

Output

输出

[Initial Post]

[Initial Post]

You can do this without a continuous VBA sub

您可以在没有连续 VBA 子程序的情况下执行此操作

Step 1

第1步

Define a range name to contain all the sheet names, (from this great example from David Hager)

定义一个范围名称以包含所有工作表名称，（来自 David Hager 的这个很好的例子）

In this example I used AllSheets
with a reference of
=RIGHT(GET.WORKBOOK(1),LEN(GET.WORKBOOK(1))-FIND("]",GET.WORKBOOK(1)))

在这个例子中，我使用 AllSheets
了一个参考
=RIGHT(GET.WORKBOOK(1),LEN(GET.WORKBOOK(1))-FIND("]",GET.WORKBOOK(1)))

Step 2
Use an INDEX formula to pull out each unique sheet on your summary sheet
=IF(ROW()<=COUNTA(AllSheets),INDEX(AllSheets,ROW()),"")& LEFT(RAND(),0)

步骤 2
使用 INDEX 公式提取汇总表上的每个唯一表
=IF(ROW()<=COUNTA(AllSheets),INDEX(AllSheets,ROW()),"")& LEFT(RAND(),0)

Assuming your summary sheet is at the far left (ie sheet 1) then ROW() will be 2 in A2, so this will pull the second sheet from AllSheets
ROW() will be 3 in A3, so this will pull the third sheet from AllSheetsetc

假设你的汇总表是最左侧（即片材1），然后ROW（）将在A2 2，所以这将拉动从第二片AllSheets
ROW（）将在A3 3，所以这将拉动从第三片材AllSheets等

The LEFT(RAND(),0)ensures that the sheet name list updates as soon as any sheet name is changed (and VBA solution would need to monitor the sheet names for changes)

在LEFT(RAND(),0)该表名称列表更新只要任何工作表名称被改变（和VBA解决方案将需要监控更改工作表名称）保证

Step 3
Use INDIRECT to pull out A1, B1 and C1 for each sheet =IF($A2<>"",INDIRECT("'"&$A2&"'!"&B$1),"")

步骤 3
使用 INDIRECT 拉出每张纸的 A1、B1 和 C1 =IF($A2<>"",INDIRECT("'"&$A2&"'!"&B$1),"")

Copy this B2 formula to the right and down as far as you expect potental sheet names

将此 B2 公式复制到右侧和下方，直到您期望潜在的工作表名称

Note that this formula handles the 'that occur for sheet names with spaces etc

请注意，此公式处理'带有空格等的工作表名称发生的情况

回答by assylias

You could probably use the INDIRECTfunction. For example, to get the value of cell A1 on sheet John, you can call:

您可能会使用该INDIRECT功能。例如，要获取工作表 John 上单元格 A1 的值，您可以调用：

=INDIRECT("John!A1")

So in your case you could put "John" in cell A1 of your summary tab, "A1" in cell B1 of the summary tab and in cell C1, put the following formula:

因此，在您的情况下，您可以将“John”放在摘要选项卡的单元格 A1 中，将“A1”放在摘要选项卡的单元格 B1 和单元格 C1 中，输入以下公式：

=INDIRECT("'"A1&"'!"&B1)

回答by len

There is no function built into excel that will give you all the sheet names in the workbook. For this you would have to turn to VBA, the scripting facility built into Excel. If you are on Office 2007 or above, this would require you to store your workbook in a special format. Also, to execute the macro, the user has to specifically allow macro execution. The following macro will allow you to print all sheet names in the first column. An important point to note is that this code would have to be executed in the code window of the summary sheet.

excel 中没有内置功能可以为您提供工作簿中的所有工作表名称。为此，您必须求助于 VBA，这是 Excel 中内置的脚本工具。如果您使用的是 Office 2007 或更高版本，这将要求您以特殊格式存储工作簿。此外，要执行宏，用户必须明确允许宏执行。以下宏将允许您打印第一列中的所有工作表名称。需要注意的重要一点是，必须在摘要表的代码窗口中执行此代码。

Sub SheetNames() 
    For i = 1 To Sheets.Count 
        Cells(i, 1) = Sheets(i).Name 
    Next i 
End Sub 

Once you have the names of the sheet, you can dynamically link to the cells in the sheets by using the following formula:

获得工作表的名称后，您可以使用以下公式动态链接到工作表中的单元格：

=INDIRECT(ADDRESS(1, 1, 1, 1, A1))
=INDIRECT(ADDRESS(1, 2, 1, 1, A1))
=INDIRECT(ADDRESS(1, 3, 1, 1, A1))

The INDIRECT formula takes an address. The ADDRESS formula works as follows ADDRESS(Row_num, Column_num, Abs_num, A1, Sheet_text). Excel help will be able to answer any questions.

INDIRECT 公式需要一个地址。ADDRESS 公式的工作方式如下 ADDRESS(Row_num, Column_num, Abs_num, A1, Sheet_text)。Excel 帮助将能够回答任何问题。

You could setup the formula and run the macro only when there are a lot of new sheets. The workbook can then be stored without the macro. Just keep the macro in a text file somewhere in case you need it again.

只有当有很多新工作表时，您才能设置公式并运行宏。然后可以在没有宏的情况下存储工作簿。只需将宏保存在某个文本文件中，以防您再次需要它。

回答by chris neilsen

Here's a solution using a VBA UDF to get the sheet names. It includes a Hyperlink as requested.

这是使用 VBA UDF 获取工作表名称的解决方案。它根据要求包含一个超链接。

The call to the UDF is placed in an out of the way column. I've used Hfor this example

对 UDF 的调用放置在一个偏僻的列中。我已经用于H这个例子

Place these functions in cells A1, B1, C1, H1

将这些函数放在单元格 A1、B1、C1、H1 中

A1: =IF(H1<>"",HYPERLINK(SUBSTITUTE(H1,"]","]'")&"'!A1",INDIRECT("'"&$H1&"'!R1C[0]",FALSE)),"")

A1： =IF(H1<>"",HYPERLINK(SUBSTITUTE(H1,"]","]'")&"'!A1",INDIRECT("'"&$H1&"'!R1C[0]",FALSE)),"")

B1 and C1: =IF($H1<>"",INDIRECT("'"&$H1&"'!R1C"&COLUMN(),FALSE),"")

B1和C1： =IF($H1<>"",INDIRECT("'"&$H1&"'!R1C"&COLUMN(),FALSE),"")

H1: =SheetByIndex()

H1： =SheetByIndex()

Put this in a VBA module

把它放在一个 VBA 模块中

Function SheetByIndex() As Variant
    Application.Volatile

    Dim r As Range
    Dim shIdx As Long
    Dim ThisShIndex As Long
    Dim sh As Worksheet
    Dim wb As Workbook

    Set r = Application.Caller

    ThisShIndex = r.Worksheet.Index
    shIdx = r.Row
    If shIdx >= ThisShIndex Then
        shIdx = shIdx + 1
    End If

    Set wb = r.Worksheet.Parent
    On Error Resume Next
    Set sh = wb.Worksheets(shIdx)
    If Err.Number <> 0 Then
        SheetByIndex = ""
    Else
        SheetByIndex = "[" & wb.Name & "]" & sh.Name
    End If
End Function

Copy formulas in A, B, C, H down as far as required

根据需要向下复制 A、B、C、H 中的公式

回答by Jerry Beaucaire

My slightly differnt approach, based on the code published here(there's a sample sheet there, too, for testing):

我的方法略有不同，基于此处发布的代码（那里也有一个示例表，用于测试）：

Option Explicit

Sub CreateHyperlinkedSheetList()
'Author:    Jerry Beaucaire
'Date:      1/3/2011

Dim ws As Worksheet, NR As Long
Application.ScreenUpdating = False

With ActiveSheet
    NR = .Range("A" & Rows.Count).End(xlUp).Row + 1
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> .Name Then
            .Range("A" & NR).Value = ws.Range("A1").Value
            .Hyperlinks.Add Anchor:=.Range("A" & NR), Address:="", SubAddress:= _
                "'" & ws.Name & "'!A1", TextToDisplay:=ws.Name
            .Range("B" & NR).Value = ws.Range("B1").Value
            .Range("C" & NR).Value = ws.Range("C1").Value
            NR = NR + 1
        End If
    Next ws
End With

Application.ScreenUpdating = True
End Sub