时间戳

首页 > 解决方案 > 选择整列VBA中的相邻单元格

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

问题描述

代码 ：

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代码，上面的代码就是我现在拥有的。

标签： vbaexcel

解决方案

请尝试一下，看看它是否适合您。

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

推荐阅读