使用Range()和Cells()

时间:2018-08-16 00:08:43

标签: excel vba

我正在尝试弄清楚如何使用RANGE()CELLS()选择多个不连续的范围。

我的工作表(第5页)看起来像这样:

 | A | B | C |    D   | E |     F     |
 +---+---+---+--------+---+-----------+
1|...|...|...|Category|...|Description|
2|...|...|...|Apple   |...|Fruit      |
3|...|...|...|Carrot  |...|Vegetable  |
4|...|...|...|Hat     |...|Clothing   |
  • 我想将Category列和Description列设置为可以复制并粘贴到另一个文件的范围。
  • 列标题在第一行。
  • 我要查找的列是当前Column DColumn F中,但它们可能会移动。
  • 这两列是不连续的范围,例如,我不想在Column E中选择任何内容。

到目前为止,我拥有的代码可以找到Category列,Description列和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,这是一个非连续的范围。 / p>

我看过this answer并发现了一些有用的信息,但是对于不连续的范围似乎没有帮助。

我也一直在MSDN上浏览Range.Cells documentation,但是没有运气。

如何使用我的变量选择包含CategoryDescription的列而之间没有任何内容?

1 个答案:

答案 0 :(得分:2)

您可以使用Union完成此操作。

您还需要编写代码,以找到没有您的标头值的选项。否则,您可能最终将Nothing的值推入会出错的范围

enter image description here

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