单击一个单元格以将字符串添加到列表底部

Question

我对在 Excel 中使用宏还很陌生，所以我希望这个问题不会太傻。

我正在创建一个工作表来跟踪销售情况。我在一列中有一个饮料列表，我想为单元格分配一个宏，这样当你点击它们时，它们单元格中的文本就会被复制到另一列。

我知道您可以录制宏来复制和粘贴值，但我不确定如何让它复制列中下一个空单元格中的文本，而不仅仅是第一个单元格中的文本。

总而言之，这些是我的表格。我希望能够单击 Drinks 列中的一个单元格，并让字符串出现在 list 列的底部（所以在 'Cuba Libre')

谢谢！

EDIT_1:

好的，到目前为止这是我的代码：

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If Target.Address = "$C" Then
       Range("C2").Select
       Selection.Copy
       Range("A2").Select
       ActiveSheet.Paste
   End If
End Sub

^我已经为 C 列 (C2:C5) 中的每个相关单元格重复了此代码。

就像我说的，我只能将 Drinks 列中的值复制粘贴到 List 列，我不知道如何将值粘贴到下一个空单元格中。

Answer 1

您需要扩大对 Target 的检查以包括整个饮料系列。然后确定 List

中的下一个可用单元格

类似于（A 列中的列表和 C 列中的饮料的硬编码）

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rDrinks As Range
    
    ' single cell has been selected
    If Target.Cells.Count = 1 Then
        ' Get ref to Drinks range
        Set rDrinks = Me.Range(Me.Cells(2, 3), Me.Cells(Me.Rows.Count, 3).End(xlUp))
        ' Is selected cell in drinks range?
        If Not Application.Intersect(Target, rDrinks) Is Nothing Then
            ' add to list
            Me.Cells(Me.Rows.Count, 1).End(xlUp).Offset(1, 0).Value2 = Target.Value2
        End If
    End If
End Sub

Answer 2

更新所以我设法弄清楚如何让宏将单元格值粘贴到列表底部！

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim LastRow As String

   If Target.Address = "$C" Then
       Range("C2").Select
       Selection.Copy
       LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
       Range("A" & LastRow).Activate
       ActiveSheet.Paste
       Application.CutCopyMode = False
   End If
End Sub

但是，我有一个 quality-of-life 问题。有什么方法可以编辑代码，使其适用于 C2:C10 范围内的所有单元格？因为就目前而言，我将不得不为每个单元格重复代码，替换范围内所有单元格的第 3 行和第 4 行。

If Target.Address = "$C" Then
       Range("C2").Select

Answer 3

如果你真的把 List 和 Drinks 变成表格（用那些名字），你可以使用下面的代码

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim i As Integer
    Dim row As Integer
    
    ' Check user has clicked on a drink
    If Not Intersect(Target, [Drinks]) Is Nothing And Target.Cells.Count = 1 Then
        ' Find first blank row in List
        For i = [List].Rows.Count To 1 Step -1
            If [List].Cells(i, 1) = "" Then
                row = i
            End If
        Next
        
        ' If no blank row, add a new row
        If row = 0 Then
            ListObjects("List").ListRows.Add
            row = [List].Rows.Count
        End If
        
        [List].Cells(row, 1) = Target
    End If
End Sub

单击一个单元格以将字符串添加到列表底部

Click a cell to add a string to the bottom of a list

excel

vba

copy-paste