根據 excel 中單元格的值獲取整行

Question

我正在嘗試根據任何單元格的值獲取具有從 E 到 BH 的特定范圍的整行數據。 例如，如果我在單元格 P,3 上有值“紅色”，我想選擇從 E3 到 BH,3 的整個范圍。

此外，如果我在 F9 中的單元格上有值“黃色”，我想 select 從 E9 到 BH9 的整行

到目前為止我已經嘗試過這是我從字符串“我的文本”中獲取行的嘗試，但是它不起作用。 我計划以類似的方式獲取行和列，以便我可以根據文本獲取從 e(row) 到 bh(row) 的行

Dim rng1 As Range
Set rng1 = Sheets("Table").UsedRange.Find("my text", xlValues, xlWhole)
Debug.Print "row is: " & rng1

Answer 1

也許使用Intersect和EntireRow 。 請注意，您還應該使用If Not rng1 Is Nothing測試Find是否成功。

Set rng1 = Sheets("Table").UsedRange.Find(What:="my text", LookIn:=xlValues, LookAt:=xlWhole)

If Not rng1 Is Nothing Then
    Dim theNewRange As Range
    Set theNewRange = Intersect(rng1.EntireRow, Range("E:BH"))
End If

使用rng1.Row的更短的替代方法：

If Not rng1 Is Nothing Then
    Dim theNewRange As Range
    Set theNewRange = Range("E:BH").Rows(rng1.Row)
End If

Answer 2

Select 行范圍

• 注意關鍵部分：

   Const CopyColsAddress As String = "E:BH" Set ccrg = ws.Columns(CopyColsAddress) ccrg.Rows(i)

編碼

Option Explicit

Sub selectRowRanges()
    
    ' Constants
    Const wsName As String = "Table"
    Const FirstRow As Long = 2
    Const CopyColsAddress As String = "E:BH"
    Const CritColsList As String = "F,P"
    Const CriteriaList As String = "Yellow,Red"
    
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Worksheet
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    
    ' Last Row
    Dim cel As Range
    Set cel = ws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious)
    If cel Is Nothing Then Exit Sub
    Dim LastRow As Long: LastRow = cel.Row
    If LastRow < FirstRow Then Exit Sub
    
    ' Copy-Columns Range
    Dim ccrg As Range: Set ccrg = ws.Columns(CopyColsAddress)
    
    ' Criteria
    Dim CritCols() As String: CritCols = Split(CritColsList, ",")
    Dim Criteria() As String: Criteria = Split(CriteriaList, ",")
    Dim cUpper As Long: cUpper = UBound(CritCols)
    
    ' Additional Variables
    Dim trg As Range ' Total Range
    Dim i As Long ' Range Row Counter
    Dim n As Long ' Criteria Counter
    
    ' Loop and combine matched row ranges in Total Range.
    For i = FirstRow To LastRow
        For n = 0 To cUpper
            If ws.Cells(i, CritCols(n)).Value = Criteria(n) Then
                If trg Is Nothing Then
                    Set trg = ccrg.Rows(i)
                Else
                    Set trg = Union(trg, ccrg.Rows(i))
                End If
                Exit For
            End If
        Next n
    Next i
    
    ' Select (Copy, Delete)
    If Not trg Is Nothing Then
        ' Often we do something like:
        'trg.Copy Sheet2.Range("A2")
        ws.Activate
        trg.Select
    End If
    
End Sub

Answer 3

晚會，試圖展示另一種方法來展示版本 2019+ 的動態可能性以及對Union()范圍 function 的巧妙使用：

Sub ExampleCall()
    '[0] define search item
    Const SearchItem As String = "My text"
    Dim rng As Range: Set rng = Sheet1.UsedRange                   ' Project's sheet Code(Name)
    '[1] evaluate condition
    Dim condition$: condition = "=IF(" & rng.Address & "=""" & SearchItem & """,ROW(" & rng.Address & "),"""")"
    Dim chk: chk = Evaluate(condition)
    '[2] get findings
    Dim rng1 As Range: Set rng1 = Range("E" & rng.Rows.Count + 1)  ' set dummy range (avoiding later checks for Is Nothing)
    Dim i As Long
    For i = 1 To UBound(chk)
        If Not IsError(Application.Average(Application.Index(chk, i, 0))) Then
            Set rng1 = Union(rng1, Intersect(Rows(i), Range("E:BH")))
            '' ... or do something with data field row Application.Index(chk, i, 0)
            '  ...
        End If
    Next i
    '[3] select rows with findings (after removing dummy from union range)
    If rng1.Areas.Count > 1 Then rng1.Areas(1).Delete ' delete dummy
    rng1.Select

End Sub

Answer 4

這個提議的解決方案使用Filter來識別目標行，將它們提取到Dictionary並將字典發布到名為Output的工作表中。

Sub Get_Rows()
Const kFml As String = "= ""|"" & #WSH!#RNG & ""|""" 'Wrap the values between "|" to ensure exact matches only
Dim Dtn As Object
Dim aTarget As Variant, aData As Variant, aDataX As Variant
Dim aRowTrg As Variant, aRowFnd As Variant
Dim vValue As Variant, sFml As String, lRow As Long

    With ThisWorkbook.Sheets("Table")
        
        Rem Get Target Values Array (Two methods pick one)
        Rem 1. 'Provided (hard-coded)
        'aTarget = [{"Red","Yellow"}]
        Rem 2. Obtained from a range - adjust as required
        sFml = Replace(Replace(kFml, "#WSH", .Name), "#RNG", "B2:B3")
        aTarget = Application.Transpose(Application.Evaluate(sFml))
        
        Rem Get Data Range to Array
        With Application.Intersect(.UsedRange, .Range("E:BH"))
            aData = .Value
            sFml = Replace(Replace(kFml, "#WSH", .Worksheet.Name), "#RNG", .Address)
            aDataX = Application.Evaluate(sFml)
    
    End With: End With
    
    Set Dtn = CreateObject("Scripting.Dictionary")
    With Dtn
    
        Rem Add Header to Dictionary
        .Add 1 + .Count, Application.Index(aData, 1, 0)
    
        Rem Search & Add Rows to Dictionary
        For lRow = 2 To UBound(aData)
            
            Rem Set Target Row
            aRowTrg = Application.Index(aDataX, lRow, 0)
            For Each vValue In aTarget
                
                Rem Filter Row with Value
                aRowFnd = Filter(aRowTrg, vValue, True)
                If UBound(aRowFnd) > -1 Then
                    
                    Rem Add Target Row to Dictionary
                    .Add 1 + .Count, Application.Index(aData, lRow, 0)
                    Exit For
                
        End If: Next: Next
        
        Rem Post Dictionary to Sheet [Output] Range [E:BH]
        ThisWorkbook.Sheets("Output").Range("E:BH").Rows(1).Resize(.Count).Value = _
            Application.Index(Dtn.items, 0, 0)
    
    End With

End Sub

桌子

Output