Question

所以我已经解决了我这个问题几天了。基本上，我有多个绿色工作表（我的源工作表）和一个主工作表（主工作表），我正在处理的问题与循环遍历这些绿色工作表有关，以便从中获取某些信息并将其放在特定的页面上。我的主表中的列。为了更好地理解，以下是其中一张绿板的布局： https://imgur.com/cayZXUA 对不起，我还不能添加图像您会看到这些绿色工作表由多个框组成，每个框的大小可能不同。对于所有绿色工作表，我需要检索的某些值都固定在相同的单元格地址中，因此我将它们放入主工作表没有问题。但是有些情况是这样的： https://imgur.com/nPYyLbM 假设框包含我需要查找并将其拉到主表的信息。本质上，此框可以垂直占据任何空间，因此工资，税金和杂项支出的地址地址会发生变化。我想到了在所有绿色表中将这些框命名为“假设”的想法，如上图所示。因此，问题是如何查找此命名框的第3列并将其拉到主表？这是主要工作表结构： https://imgur.com/CWMpGvH

到目前为止，我的代码：

Sub CombiningSheets()
    Dim p_value, cst_value, m_value As Long
    Dim p, cst, m As String
    p = "payroll"
   cst = "consolidated social tax"
    m = "miscellaneous expenditures"



With ThisWorkbook.Sheets("Main")
    For Each wsheet In ThisWorkbook.Sheets


        If wsheet.Name <> "Main" Then

            Set nextEntry = .Cells(.Rows.Count, "G").End(xlUp).Offset(1, 0)
            Set nextEntry_FTE_quantity = .Cells(.Rows.Count, "K").End(xlUp).Offset(1, 0)
            Set nextEntry_nonrecurring_expenses = .Cells(.Rows.Count, "S").End(xlUp).Offset(1, 0)
            Set nextEntry_initiative_type = .Cells(.Rows.Count, "Q").End(xlUp).Offset(1, 0)
            Set nextEntry_initiative_description = .Cells(.Rows.Count, "E").End(xlUp).Offset(1, 0)
            Set nextEntry_economic_benefit = .Cells(.Rows.Count, "AA").End(xlUp).Offset(1, 0)
            Set nextEntry_payroll = .Cells(.Rows.Count, "AI").End(xlUp).Offset(1, 0)
            Set nextEntry_consolidated_social_tax = .Cells(.Rows.Count, "AJ").End(xlUp).Offset(1, 0)
            Set nextEntry_miscellaneous_expenditures = .Cells(.Rows.Count, "AK").End(xlUp).Offset(1, 0)


            If IsError(Application.Match(wsheet.Name, .Range("G:G"), 0)) Then

                nextEntry.Value = wsheet.Name
                nextEntry_initiative_description.Value = wsheet.Range("K6").Value
                nextEntry_FTE_quantity.Value = wsheet.Range("BH16").Value
                nextEntry_initiative_type.Value = wsheet.Range("K8").Value
                nextEntry_nonrecurring_expenses.Value = wsheet.Range("BH17").Value
                nextEntry_economic_benefit.Value = wsheet.Range("BH15").Value

            End If

        End If
        Debug.Print wsheet.Name
        Next wsheet
    End With


End Sub

Answer 1

从您的问题看来，您已经定义了命名范围。据我了解到您的问题 How to copy sheets with certain tab color from one workbook to another? ，我相信您没有在单个工作表中命名范围。

如果您已命名范围（Sub List_NamedRange_Loop），则会在下面找到一些代码。
如果您没有命名范围，则可以先在各个工作表上创建这些命名范围（Sub Create_NamedRange）。

在这篇文章的结尾，您可以找到我得到的结果的屏幕截图。

DisplayNoteFragment

如果您没有命名范围，则可以使用类似于以下代码的方式创建它们：

Sub List_NamedRange_Loop()

Dim NamedRange As Name
Dim ws As Worksheet
Dim PrDebug As Boolean
Dim iCt As Integer

PrDebug = False      '        => Output to Worksheet "Main"
'PrDebug = True      '        => Output to Immediate Window (Ctrl-G in VBE)

'List on sheet "main"
If Not (PrDebug) Then
    On Error Resume Next
    Debug.Print ActiveWorkbook.Name
    Sheets("main").Activate
    If ActiveSheet.Name <> "main" Then
        Worksheets.Add
        ActiveSheet.Name = "main"
    End If
    On Error GoTo 0
    Range("A1:D1000").ClearContents
    Range("A1").Value = "Sheet Name"
    Range("B1").Value = "Named Range"
    Range("C1").Value = "RefersTo"
    Range("D1").Value = "Value (Direct Reference)"
    Range("E1").Value = "Value (Named Reference)"
End If

'We expect all named ranges to be local = defined on the indivdual sheets
'so no need for the below 'workbook loop'

'Loop through each named range in workbook
'  For Each namedrange In ActiveWorkbook.Names
'    Debug.Print namedrange.Name, namedrange.RefersTo
'  Next namedrange

'Loop through each named range scoped to a specific worksheet
    iCt = 0
    For Each ws In Worksheets
        iCt = iCt + 1
        If ws.Names.Count > 0 Then
            If PrDebug Then
                Debug.Print
                Debug.Print ws.Name
            Else
            End If
            For Each NamedRange In ws.Names 'Worksheets("Sheet1").Names
                If PrDebug Then
                    Debug.Print ws.Name, NamedRange.Name, NamedRange.RefersTo
                Else
                    iCt = iCt + 1
                    Range("A1").Offset(iCt, 0).Value = ws.Name
'                    Range("B1").Offset(iCt, 0).Value = Replace(NamedRange.Name, ws.Name & "!", "")
                    If InStr(1, NamedRange.Name, "'") Then
                        Range("B1").Offset(iCt, 0).Value = Replace(NamedRange.Name, "'" & ws.Name & "'!", "")
                    Else
                        Range("B1").Offset(iCt, 0).Value = Replace(NamedRange.Name, ws.Name & "!", "")
                    End If
                    Range("C1").Offset(iCt, 0).Value = "'" & NamedRange.RefersTo
                    Range("D1").Offset(iCt, 0).Value = NamedRange.RefersTo
                    Range("E1").Offset(iCt, 0).Formula = "=" & NamedRange.Name
                    Range("E1").Offset(iCt, 0).Calculate
                End If
            Next NamedRange
        Else
'            iCt = iCt + 1
'            Range("A1").Offset(iCt, 0).Value = ws.Name
'            Range("B1").Offset(iCt, 0).Value = "NO NAMES DEFINED!"
        End If
    Next ws

End Sub

Answer 2

我将使用Range.Find通过关键字来定位单元格并返回与它们相邻的值。

Sub TestFind()
    Dim colOffset As Long
    Dim wsheet As Worksheet
    colOffset = Columns("BH").Column - Columns("AR").Column - 2 'Two Extra Cells in Merged Range  Adjustment
    For Each wsheet In ThisWorkbook.Worksheets
        If wsheet.Name <> "Main" Then
            Debug.Print FindValueRelativeToSearch(wsheet.Columns("AR"), "payroll", 0, colOffset)
            Debug.Print FindValueRelativeToSearch(wsheet.Columns("AR"), "social tax", 0, colOffset)
            Debug.Print FindValueRelativeToSearch(wsheet.Columns("AR:AT"), "miscellaneous expenditures", 0, colOffset)
        End If
    Next

End Sub

Function FindValueRelativeToSearch(SearchRange As Range, search As String, rowOffset As Long, colOffset As Long) As Variant
    Dim cell As Range
    Application.FindFormat.MergeCells = True
    With SearchRange
        Set cell = .Find(What:=search, After:=.Cells(1, 1), _
                         LookIn:=xlFormulas, _
                         LookAt:=xlWhole, _
                         SearchOrder:=xlByRows, _
                         SearchDirection:=xlNext, _
                         MatchCase:=False, _
                         SearchFormat:=True)
    End With
    cell.Offset(rowOffset, colOffset).Activate
    If cell Is Nothing Then
        Debug.Print "Search not found: FindValueRelativeToSearch()", SearchRange.Address(0, 0, xlA1, True), search
    Else
        FindValueRelativeToSearch = cell.Offset(rowOffset, colOffset).Value
    End If

End Function

在多个工作表中通过预定义的命名范围循环vlookup

2 个答案: