找到范围地址#2

时间:2017-12-04 19:27:55

标签: excel vba

因为我没有具体回答我之前提出的问题,所以我再次需要你的帮助。

基本上,我问是否有办法找到一些值/单元格之间的范围,因为我确信当我将获得该范围时,下面的内容将起作用(所以我可以选择让我们说“标题”的列以下所有数据:

totalRange(选择,选择。结束(xlDown))。选择

所以你们中的一个想出了帮助并提供下面的代码,这工作得很好,但我不确定我是否可以在我的情况下使用它。因为正如我所说,我想要做的是首先在第一个两个单元格之间找到一个范围,然后用它选择下面的所有数据。类似于下面的截图。 我想找到Col7和Col12,然后选择下面的整个范围。 问题是Col7 / Col12范围可能从每个文件中的不同列开始。

https://ibb.co/gtuvEb

Sub RangeBetween()


Dim totalRange As Range
Dim c1 As Long, c2 As Long
Dim r1 As Long, r2 As Long

r1 = 0
r2 = 0

c1 = 1
c2 = 1
With Worksheets("Sheet1") 'Change to your worksheet

    c1 = 1
    Do Until Name = "A"
        Name = Cells(1, c1)
        c1 = c1 + 1
    Loop
    c1 = c1 - 1

    c2 = 1
    Do Until Name = "B"
        Name = Cells(1, c2)
        c2 = c2 + 1
    Loop
    c2 = c2 - 1

    On Error Resume Next
        r1 = Application.WorksheetFunction.Match("A", .Columns(c1), 0)
        r2 = Application.WorksheetFunction.Match("B", .Columns(c2), 0)
    On Error GoTo 0

    If r1 > 0 And r2 > 0 Then
        Set totalRange = .Range(.Cells(r1, c1), .Cells(r2, c2))
        totalRange.Select
    Else
        MsgBox "One or both items not found in range"
    End If
End With

End Sub

感谢您的任何建议。

2 个答案:

答案 0 :(得分:1)

Sub RangeBetween()


Dim totalRange As Range
Dim c1 As Long, c2 As Long
Dim r1 As Long

With Worksheets("Sheet1") 'Change to your worksheet

    On Error Resume Next
        'Find the Columns
        c1 = Application.WorksheetFunction.Match("Col7", .Rows(1), 0)
        c2 = Application.WorksheetFunction.Match("Col12", .Rows(1), 0)
    On Error GoTo 0

    If c1 > 0 And c2 > 0 Then
        'Find last row with data
        r1 = .Cells(.Rows.Count, c2).End(xlUp).Row
        'Set the range to the whole
        Set totalRange = .Range(.Cells(1, c1), .Cells(r1, c2))
        totalRange.Select
    Else
        MsgBox "One or both items not found in range"
    End If
End With

End Sub

答案 1 :(得分:0)

您似乎尝试在标题中查找某些值并选择这些列之间的值。如果我理解正确,你的问题可以帮助你。

Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("your sheet")

Dim header1 As Range, header2 As Range

On Error Resume Next
Set header1 = ws.Rows(1).Find(what:="your header value 1", LookIn:=xlValues, 
lookat:=xlWhole)
Set header2 = ws.Rows(1).Find(what:="your header value 2", LookIn:=xlValues, 
lookat:=xlWhole)
On Error GoTo 0

If Not header1 Is Nothing And Not header2 Is Nothing Then
    Range(header1, 
    header2).EntireColumn.SpecialCells(xlCellTypeConstants).Select
Else:
    MsgBox "Header not fount"
End If