代码之家 › 专栏 › 技术社区 › girlvsdata

使用Range()和Cells()选择多个非连续范围

vba excel

girlvsdata · 技术社区 · 6 年前

RANGE() 和 CELLS()

我的工作表 (第5张)

 | A | B | C |    D   | E |     F     |
 +---+---+---+--------+---+-----------+
1|...|...|...|Category|...|Description|
2|...|...|...|Apple   |...|Fruit      |
3|...|...|...|Carrot  |...|Vegetable  |
4|...|...|...|Hat     |...|Clothing   |

我想设置 Category 列和 Description
列标题在第一行。
我要找的栏目是目前在里面 Column D 和 Column F 但他们可能会搬家。
这两列是不连续的范围,我不想在 Column E

我目前掌握的代码发现 类别 列, 列,和 lastrow . 当我使用变量来选择范围时,我使用 Range() Cells() .

我的代码:

Sub SelectNonContiguousRangeCells()

'Create variables
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range
Dim lastrow As Long
Dim strCat As String
Dim strDesc As String
Dim rngCat As Range
Dim rngDesc As Range
Dim rngCopy As Range

'Initialize variables
Set wb = ThisWorkbook
Set ws = Sheet5
lastrow = ws.Range("A1").End(xlDown).Row

'Find the column headers
strCat = "Category New"
strDesc = "Requirement Description"
Set rngCat = ws.Range("A1:Z1").Find(strCat)
Set rngDesc = ws.Range("A1:Z1").Find(strDesc)

'Set the copy range
Set rngCopy = Range(Range(Cells(1, rngCat.Column), Cells(lastrow, rngCat.Column)), Range(Cells(1, rngDesc.Column), Cells(lastrow, rngDesc.Column))).SpecialCells(xlCellTypeVisible)
Debug.Print rngCopy.Address

End Sub

Debug.Print 这是 $D$1:$F$449 ,这是一个连续的范围,而我希望看到 $D$1:$D$449,$F$1:$F$449 ,这是一个不连续的范围。

我已经看过了 this answer 找到了一些有用的信息,但似乎对非连续范围没有帮助。

我也一直在查 Range.Cells documentation

如何使用变量选择包含 类别 和 说明 中间没有任何东西?

1 回复 | 直到 6 年前

urdearboy 6 年前

你可以用 Union 为了实现这一点。

您还需要为两个头值都找不到的选项编写代码。否则,您可能最终会将 Nothing 进入一个会出错的范围

Option Explicit

Sub SelectNonContiguousRangeCells()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet5")
Dim rngCat As Range, rngDesc As Range, rngCopy As Range
Dim lastrow As Long

lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row

Set rngCat = ws.Range("A1:Z1").Find("Category New").Resize(lastrow, 1)
Set rngDesc = ws.Range("A1:Z1").Find("Requirement Description").Resize(lastrow, 1)

If Not rngCat Is Nothing Then
    If Not rngDesc Is Nothing Then
        Set rngCopy = Union(rngCat, rngDesc)
    End If
End If

Debug.Print rngCopy.Address (False, False)

End Sub

推荐文章

Kram Kramer · 通过vba自动调整文本大小以适应形状

5 月前