Question

enter image description here我有一本工作手册，其中包含S＆amp; P 500中每个行业的不同工作表，即Tech，Energy，Ect。我创建了一个带有两个列表框的用户表单，允许用户首先选择一个扇区，然后选择该扇区独有的子扇区。列表框工作正常，但现在我想创建一个命令按钮，它接受用户选择的任何子扇区，并使包含该子扇区的活动工作表上的第一行数据成为活动单元格。

Private Sub GoToSectorButton_Click()
'Declare variables
Dim SubIndustry As String
Dim IntRow As Integer

'Set list box value equal to the variable
SubIndustry = lstSubIndustry.Value

'Locate the first occurance of the Sub Industry
IntRow = 3

'Select the row that contains
ActiveSheet.cell(SubIndustry).Select

End Sub


Private Sub UserForm_Initialize()

'declare variable
Dim shtIndustry As Worksheet
'shows Industries in lstIndustry that aren't the first set of sets
For Each shtIndustry In Application.Workbooks("VBA_Finance_Project_KEZE6983.xlsm").Worksheets
    If shtIndustry.Name <> "Welcome" And shtIndustry.Name <> "Name Or Sector" And shtIndustry.Name <> "Name" And shtIndustry.Name <> "Sector" And shtIndustry.Name <> "Filter" And shtIndustry.Name <> "Master" Then

        lstIndustry.AddItem (shtIndustry.Name)

    End If
Next shtIndustry

'select default list box item
lstIndustry.ListIndex = 0

End Sub

Private Sub lstIndustry_Click()

'declare variables
Dim strSI As String, rngData As Range, rngCell As Range, shtSubIndustry As Worksheet

'clear list box
lstSubIndustry.Clear

'Save relevant worksheets to a vaiable so that we can use the vaiable in the rest of the program as a shortcut
Set shtSubIndustry = Application.Workbooks("VBA_Finance_Project_KEZE6983.xlsm").Worksheets(lstIndustry.ListIndex + 5)

'activate worksheet clicked
shtSubIndustry.Activate

'assign address of Industry data to rngData variable
Set rngData = Application.Workbooks("VBA_Finance_Project_KEZE6983.xlsm").ActiveSheet.Range("A3").CurrentRegion

'assign Column heading to srtSI variable
strSI = "GICS Sub Industry"

'Add the Sub Industry
For Each rngCell In rngData.Columns(14).Cells
    If rngCell.Value <> strSI And rngCell.Value <> "" Then
        lstSubIndustry.AddItem rngCell.Value
        strSI = rngCell.Value
    End If
Next rngCell

'select default list box item
lstSubIndustry.ListIndex = 0


End Sub

Answer 1

您应该遍历包含subIndustry值的行。如果子行业名称位于“A＆＃39;”列中。

类似（警告：未经测试）

Dim c as Range
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For Each c In Range("A1:A" + LastRow).Cells
  If c.Value == subIndustry Then
    c.parent.activate 'Activate worksheet
    c.select
    Exit
  End If
Next

Answer 2

我用于加入逻辑的函数下面，它有助于识别匹配记录的行号。

此功能灵活，可以匹配多个条件。

在你的情况下，

ActiveWindow.ScrollRow = getRowMultiMatch(Array(Range("M:M"), Range("N:N")), 1, Array(Sector,Subsector))


Function getRowMultiMatch(ByVal arrRange As Variant, ByVal startMatchOnRow As Single, ByVal arrMatchValue As Variant) As Single
'Return 0 if unable to match
'arrRange = Array of Source Range
'startMatchOnRow = 1
'arrMatchValue = Array of Value need to Match

Dim i, nRow, nStartRow, nLastRow As Single
Dim nRng, dataRng, nColRng As Range
Dim nWSD As Worksheet
Dim nValue As Variant

        Set nColRng = arrRange(0)
        Set nWSD = nColRng.Parent

        'Start and Last (Row Number) Help define when to stop looping
        nStartRow = nColRng.Cells(1).Row
        If startMatchOnRow > nStartRow Then nStartRow = startMatchOnRow
        nLastRow = nColRng.Cells(nColRng.Cells.Count).Row

Retry:
        'Sizing nRng
        Set nRng = Intersect(nColRng.EntireColumn, nWSD.Range(nWSD.Rows(nStartRow), nWSD.Rows(nLastRow)))

        nValue = arrMatchValue(0)
        If IsNumeric(nValue) = False Then
            nValue = CStr(nValue)
            nValue = Replace(nValue, "*", "~*")
        End If

        'Matching First Item
        If IsError(Application.Match(nValue, nRng, 0)) Then
            getRowMultiMatch = 0
            Exit Function
        Else
            nRow = Application.Match(nValue, nRng, 0)
            'Looping to Check if all values are match
            For i = 1 To UBound(arrMatchValue) 'Start loop from 2nd Item
                Set dataRng = Intersect(nWSD.Rows(nStartRow + nRow - 1), arrRange(i).EntireColumn)
                If StrComp(dataRng.Value, arrMatchValue(i)) <> 0 Then
                    'Not Match
                    'Resize nRng then Retry
                    GoTo NotMatch
                Else
                    'Matched
                End If
            Next i
            'All Matched
            getRowMultiMatch = nStartRow + nRow - 1
            Exit Function
NotMatch:
            nStartRow = nStartRow + nRow
            If nStartRow > nLastRow Then
                Exit Function
            Else
                GoTo Retry
            End If
        End If

End Function

使用列表框选择选择并转到单元格

2 个答案: