☰

按下按钮循环显示某个范围的值

tag-icon • tag-icon microsoft-excel vba
按下按钮循环显示某个范围的值

我正在尝试创建一个按钮来自动使用B5另一张表的单元格中的信息填充单元格A1:A10。

当按下按钮时，我希望B5包含来自单元格的信息A1。然后，当再次按下按钮时，它应该包含来自的信息，A2依此类推。

答案1

这是一个简单的方法。

您需要一个计数器，以便每次按下按钮时计数器都增加。您需要将其放在电子表格的某个位置，在本例中，它位于按钮下方。

  1. 首先确定计数器的位置，在这个例子中，它将位于按钮的正下方。

计数器将增加

  1. 插入你的按钮。

插入按钮（表单控件）

  1. 将宏分配给您的按钮，确保将其保存到工作簿。

指定宏

  1. 将以下代码粘贴到 VBA 编辑器中以供按钮单击。

代码

Sub Button1_Click()

    Dim CopySheet As Worksheet, PasteSheet As Worksheet
    Dim xFrom As Integer, xTo As Integer, i As Integer
    Dim pasteCell As String, cCell As String

    'Sheets
    Set CopySheet = Worksheets("Sheet2") 'Sheet you are copying from.
    Set PasteSheet = Worksheets("Sheet1")  'Sheet you are pasting into.

    'Rows, range of rows start from row rStart to rEnd
    rStart = 1 'Start of Row you want to copy from.
    rEnd = 10 'End of Row you want to copy from.

    'Cells
    pasteCell = "B5" 'Cell we will paste data from CopySheet.

    'Counter will increments with each button press.
    cCell = "E5" 'Change "E5" to reference cell on your spreadsheet.
    i = Range(cCell).Value

    Application.ScreenUpdating = False 'We disable Screen Updating to prevent interruption.

    'Update Counter
    i = i + 1
    If (i > rEnd) Then
        i = rStart
    End If
    Range(cCell).Value = i

    'Copy/Paste Functions
    CopySheet.Select
    Range("A" & i).Select
    Selection.Copy
    PasteSheet.Select
    Range(pasteCell).Select
    ActiveSheet.Paste

    Application.ScreenUpdating = True 'Enable Screen Updating at end of operation.
End Sub

VBA 编辑器

按钮将根据计数器数字加 1 进行复制，因此如果按钮按下时的数字为 0，则宏将添加获得 0 + 1，然后开始复制和粘贴功能。

在此处输入图片描述

答案2

无需在工作簿的单元格中存储计数器。您可以改用静态变量。


将以下代码粘贴到任何非类模块中：

'============================================================================================
' Module     : <any non-class module>
' Version    : 0.1.1
' Part       : 1 of 1
' References : N/A
' Source     : https://superuser.com/a/1331173/763880
'============================================================================================

Option Explicit

Public Sub Next_Click()

  Const s_DestSheet As String = "Sheet1"
  Const s_DestRange As String = "B5"
  Const s_SrcSheet As String = "Sheet2"
  Const s_SrcCell As String = "A1:A10"

  Static sidxCurrentCell As Variant: If IsEmpty(sidxCurrentCell) Then sidxCurrentCell = -1

  With Worksheets(s_SrcSheet).Range(s_SrcCell)
    sidxCurrentCell = (sidxCurrentCell + 1) Mod .Cells.Count
    .Cells(sidxCurrentCell + 1).Copy Destination:=Worksheets(s_DestSheet).Range(s_DestRange)
  End With

End Sub

然后将其分配给您的按钮。


此代码的唯一问题是，当您重新打开工作簿时，它不记得它处于哪个单元格，而是从第一个单元格重新开始。如果需要，可以解决这个问题。

附录：

如果您还希望有一个“上一个”按钮来向后循环，那就有点棘手了 - 您需要一个通用的上一个/下一个子程序，并带有一个参数来确定方向。然后，需要将每个按钮分配给单独的子程序，这些子程序使用适当的参数调用主程序：

'============================================================================================
' Module     : <any non-class module>
' Version    : 0.2.0
' Part       : 1 of 1
' References : N/A
' Source     : https://superuser.com/a/1331173/763880
'============================================================================================
Option Explicit

Private Sub Next_or_Previous( _
                                       ByRef direction As Long _
                            )
        Dim plngDirection As Long: plngDirection = direction

  Const s_DestSheet As String = "Sheet1"
  Const s_DestRange As String = "B5"
  Const s_SrcSheet As String = "Sheet2"
  Const s_SrcCell As String = "A1:A10"

  Static sidxCurrentCell As Variant: If IsEmpty(sidxCurrentCell) Then sidxCurrentCell = -plngDirection

  With Worksheets(s_SrcSheet).Range(s_SrcCell)
    sidxCurrentCell = (sidxCurrentCell + plngDirection + .Cells.Count) Mod .Cells.Count
    .Cells(sidxCurrentCell + 1).Copy Destination:=Worksheets(s_DestSheet).Range(s_DestRange)
  End With

End Sub

Public Sub Previous_Click()
  Next_or_Previous -1
End Sub

Public Sub Next_Click()
  Next_or_Previous 1
End Sub

答案3

我解决这个问题的方法非常不同。

我想建议工作表选择改变事件代替按钮点击因为它避免了繁琐的循环方法任务。

工作表选择更改几乎就像按钮点击，因为购买 10 个物品需要 10 次点击，并且选择改变事件也需要类似的点击，最好的部分是顺序，可以是升序/降序甚至是随机的。

A1:A10下面编写的代码将在鼠标单击时将单元格从指定的数据范围复制到目标工作表的单元格。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
    With Sheets("Sheet2")
        .Select
        .Range("B5").Value = Target.Value
    End With
End If
End Sub

宏的工作原理：

  • A1:A10单击以下位置之间的任意单元格源表复制到目标工作表的单元格 B5。

笔记，源范围A1:A10、目标工作表的名称Sheet2和单元格B5均可编辑。

相关内容