显示上一行元素的Excel按钮

问题描述 投票:0回答:2

我使用了https://stackoverflow.com/a/34454648/11447549中的代码我得到它来使用动态列长度,并从另一个工作表中的单元格获取值。目前,这段代码为我提供了下一行的元素(即A1->单击-> A2),如果是最后一个元素,它将返回到第一行。知道我需要这个来后退。它需要从下到上,如果碰到第一个,请转到最后一个。我尝试反转Range的参数,但出现错误。任何想法或提示都将非常有用。

Sub Button8_Click()
    Set wsh = ActiveWorkbook.Worksheets("Sheet1")
    Column = wsh.Range("A" & Rows.Count).End(xlUp).Row

    If IsError(Application.Match(Range("B2").Value, wsh.Range(wsh.Cells(2, 1), wsh.Cells(Column, 1)), 0)) Then
        Range("B2").Value = wsh.Cells(2, 1).Value
    ElseIf Application.Match(Range("B2").Value, wsh.Range(wsh.Cells(2, 1), wsh.Cells(Column, 1)), 0) = wsh.Range(wsh.Cells(2, 1), wsh.Cells(Column, 1)).Cells.Count Then
        Range("B2").Value = wsh.Cells(2, 1).Value
    Else
        Range("B2").Value = wsh.Cells(2, 1).Offset(Application.Match(Range("B2").Value, wsh.Range(wsh.Cells(2, 1), wsh.Cells(Column, 1)), 0), 0).Value
    End If
End Sub
excel vba
2个回答
0
投票

如果绝对确定没有重复项,则可以使用Range.Find方法,它是内置的VBA函数。

Option Explicit
Private Sub CommandButton1_Click()
    Dim rDest As Range, rCol As Range, C As Range
    Dim wsSrc As Worksheet
    Dim myRow As Long, LR As Long

Set wsSrc = Worksheets("sheet2") 'or whatever

With wsSrc
    Set rCol = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

Set rDest = Cells(2, 2)

With rCol
    Set C = .Find(what:=rDest, after:=rCol(1, 1), LookIn:=xlValues, _
                lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
    If Not C Is Nothing Then
      If C.Row = 1 Then Set C = rCol(rCol.Rows.Count + 1, 1)
        rDest = C.Offset(-1, 0)
    Else
        rDest = rCol(rCol.Rows.Count, 1)
    End If
End With
End Sub

0
投票

我发现您的代码很麻烦(或者可能不够复杂:-))。这是另一个版本。双击A1即可使用。它需要安装在要对其执行操作的工作表的代码表中。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Const Rstart As Long = 2                ' set as required

    Dim Rng As Range
    Dim Rcount As Long
    Dim R As Variant

    With Target
        If .Address = Range("A1").Address Then
            ' from Rstart to last row in column B
            Set Rng = Range(Cells(Rstart, "B"), Cells(Rows.Count, "B").End(xlUp))
            Rcount = Rng.Cells.Count

            On Error Resume Next
            R = Application.Match(.Value, Rng, 0)
            If Err Then
                R = Rcount
            Else
                R = R + 1
                If R > Rcount Then R = 1
            End If

            .Value = Rng.Cells(R).Value

            .Offset(1).Select
        End If
    End With
End Sub

一旦您理解了代码,就更易于阅读和修改。例如,要更改单元格A1,您所需要做的就是更改此代码行中对A1的引用。 如果.Address = Range(“ A1”)。Address

您的选择列表不必从第1行开始。Const Rstart现在的值为2,这意味着您的列表从第2行开始,允许有列标题,但是如果您将其更改为1,更喜欢,或者3。

代码行Set Rng = Range(Cells(Rstart,“ B”),Cells(Rows.Count,“ B”)。End(xlUp))]将列表的范围设置为B列。更改两个“ B”将其移到另一列。它动态地找到终点。从Rstart的设置开始。

最后,没有按钮。但是,如果您希望双击一个按钮,则很容易使代码适应于使用一个按钮。

如果没有一个要说的话,“最终”的好处是什么。可以轻松地将此代码修改为具有不同的触发器,以引用同一张纸上的不同列表。例如,您现在可以将列表移动到B列中,使其位于A1以下。在B列中,您可能会有另一个列表,该列表响应B1中的双击,等等。

热门问题
推荐问题
最新问题