Excel - 如果文本匹配，则从所有工作表的单元格中获取数据答案

【问题标题】：Excel - Get Data from cells from all sheets, if text matchExcel - 如果文本匹配，则从所有工作表的单元格中获取数据
【发布时间】：2016-06-21 18:05:34
【问题描述】：

我有一本工作簿，其中当月的每一天都有一张工作表。示例我有以下 6 月份的工作表：

1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30

然后我有另一张名为 Master 的工作表。

在每张表格中，我在单元格A1 中都有特定日期的周数。工作表中的示例 13 到 19，A1 包含 24（因为在这些日期中是第 24 周）。

在Master 中，A1 是我应该从中获取数据的工作表的周数。所以在这里我可以输入示例 24（然后它应该从所有工作表中获取特定数据，其中A1 = 24）。 这可能吗？

具体来说，我想从G3 及以下列、A1 为 24 的每个工作表中获取数据，并将文本复制到Master 工作表、B11 列及以下。

【问题讨论】：

我的第一个想法是您可以使用Indirect() 公式结合索引/匹配来做到这一点。您需要一个将周数与天数匹配的表格，然后使用 Indirect 来处理具有匹配天数的工作表。

标签： vba excel macros

【解决方案1】：

在我看来，循环遍历每个工作表（“主”表除外）是最简单的方法，检查周数是否与主表中的周数相同，然后执行任何复制/过去活动。

例子：

Sub Macro()

Dim masterws, ws As Worksheet
Dim wb As Workbook
Dim curweek As String

Set masterws = ThisWorkbook.Worksheets("Master")
curweek = masterws.Range("A1")

For Each ws In ActiveWorkbook.Sheets

    If ws.Name <> "Master" Then

        If ws.Range("A1").Value = curweek Then
            'Perform your copy/past activities

        End If

    End If
Next

End Sub

【讨论】：

【解决方案2】：

供您参考。使用indirect函数

【讨论】：

【解决方案3】：

你可以使用下面的

Option Explicit

Sub main()
    Dim weekN As Long, rowTopasteFrom As Long
    Dim ws As Worksheet, wsMst As Worksheet

    Set wsMst = Worksheets("Master")
    weekN = wsMst.Range("A1")

    If weekN <= 0 And weekN >= 53 Then Exit Sub '<--| exit if week is not a valid number

    For Each ws In Worksheets
        If ws.Range("A1") = weekN Then '<--| first check if valid week number
            If ws.Name <> "Master" Then 
                With GetRange(ws, ws.Range("G3")) '<--| get the current worksheet range to copy values from
                    GetCellToPasteFrom(wsMst, 2, 11).Resize(.Rows.Count).Value = .Value '<--| paste values in "Master"
                End With
            End If
        End If
    Next ws
End Sub

Function GetRange(ws As Worksheet, iniRng As Range) As Range
    With ws
        Set GetRange = .Range(iniRng, .Cells(.Rows.Count, iniRng.Column).End(xlUp))
    End With
End Function

Function GetCellToPasteFrom(ws As Worksheet, col As Long, Optional minRow As Variant) As Range
    Set GetCellToPasteFrom = ws.Cells(ws.Rows.Count, col).End(xlUp).Offset(1)
    If Not IsMissing(minRow) Then If GetCellToPasteFrom.Row < minRow Then Set GetCellToPasteFrom = ws.Cells(minRow, col)
End Function

作为旁注，我在有效工作表名称之前放置了有效的周数检查，以减少后面这些检查（即仅适用于具有正确周数的工作表）

在这种特殊情况下无需真正担心，但在更具挑战性的环境中考虑一下可能会很有用

【讨论】：