Question

我想在列L中使用列表Table1中的选项制作下拉单元格，并有机会通过下拉单元格向源Table1添加新项目。如果源列表在同一工作表上，以下代码可以正常工作。但我需要在另一张表上有一个源表。

If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Columns(12)) Is Nothing Then
 If IsEmpty(Target) Then Exit Sub
   If WorksheetFunction.CountIf(Worksheets("Sheet2").Range("Table1"), Target) = 0 Then
      lReply = MsgBox("Do you want to add name  " & _
                     Target & " to the list", vbYesNo + vbQuestion)
      If lReply = vbYes Then
          Worksheets("Sheet2").Range("Table1").Cells(Range("Tabel1").Rows.Count + 1, 1) = Target
      End If
   End If
 End If

End Sub

Answer 1

尝试以下方法。最后不确定你想要的是什么，但是这将检查你在表1列L中添加的项目，如果表1中没有，则将它们作为新行添加到表中。

注意：

1）每次完全符合范围

 Worksheets("Sheet2").Range("Table1").Cells(Worksheets("Sheet2").Range("Table1").Range("Table1").Rows.Count + 1, 1)

和

2）每次以相同的方式拼写表格，如Table1或Tabel1。

代码：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim lReply As String

    If Target.Cells.Count > 1 Then Exit Sub

    If Not Intersect(Target, Columns(12)) Is Nothing Then 'L

        If IsEmpty(Target) Then Exit Sub

        If WorksheetFunction.CountIf(Worksheets("Sheet2").Range("Table1"), Target) = 0 Then

            lReply = MsgBox("Do you want to add name  " & Target & " to the list", vbYesNo + vbQuestion)

            If lReply = vbYes Then

                Worksheets("Sheet2").Range("Table1").Cells(Worksheets("Sheet2").Range("Table1").Range("Table1").Rows.Count + 1, 1) = Target

            End If

        End If

    End If

End Sub

将数据添加到单元格中的下拉列表中

1 个答案: