Question

代码：

Option Explicit

Sub selectAdjacentBelowCells()
Dim r, c As Integer
Dim r1, r2, c1, c2 As Integer
Dim i As Integer
Dim j As Integer
Dim st As String
Dim lastRow As Integer

With ActiveCell
    r = .Row
    c = .Column
End With
r1 = r
r2 = r

lastRow = ActiveSheet.Cells(Rows.Count, c).End(xlUp).Row

Dim value As Integer
value = Cells(r, c).value

Dim value1 As Integer
Dim value2 As Integer
Dim myUnion As Range
Dim myCell As Range

For i = r1 To lastRow - 1
    'selects adjacent cells below
    value1 = Cells(i + 1, c).value
    If (value1 = value) Then
        Range(Cells(i, c), Cells(i + 1, c)).Select
    Else
        Exit For
    End If
Next

Dim x As Integer
x = Cells(r2 - 1, c).value

For x = r2 To (r2 + 1) - r2 Step -1
    'selects adjacent cells above
    value2 = Cells(x - 1, c).value
    If (value2 = value) Then
        Range(Cells(r, c), Cells(x - 1, c)).Select
    Else
        Exit For
    End If
Next
End Sub

excel中的列：
10
20
30
40
50
60
60（选中此单元格，然后执行vba代码）
60
70
80
90

我需要在整列中选择相邻的单元格。它选择相邻的单元格，但首先选择下面然后上方的相邻单元格。但是在第一段代码运行后，选择更改为上方单元格，而下方单元格被取消选择。
我知道可以通过Union来完成，我尝试使用它，但是每次都会出错。遇到argument is not optional错误，然后我不得不删除Union代码，上面的代码就是我现在拥有的代码。

Answer 1

请尝试一下是否适合您。

Sub selectAdjacentBelowCells()
Dim targetCell As Range, Rng As Range, cell As Range, LastCell As Range, uRng As Range
Dim lr As Long
Dim firstAddress As String
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set targetCell = ActiveCell
Set LastCell = Range("A:A").SpecialCells(xlCellTypeLastCell)

With Range("A1:A" & lr)
    Set cell = .Find(what:=targetCell.value, after:=LastCell, LookIn:=xlValues, lookat:=xlWhole)
    If Not cell Is Nothing Then
        firstAddress = cell.Address
        Do
            If uRng Is Nothing Then
                Set uRng = cell
            Else
                Set uRng = Union(uRng, cell)
            End If
            Set cell = .FindNext(cell)
        Loop While Not cell Is Nothing And cell.Address <> firstAddress
    End If
End With

For Each Rng In uRng.Areas
    If Not Intersect(Rng, targetCell) Is Nothing Then
        Rng.Select
        Exit For
    End If
Next Rng
End Sub

选择整个列VBA中的相邻单元格

1 个答案: