Vba 打开工作簿时从逗号分隔的值创建下拉列表

我有一列用逗号分隔的值从DB填充。范围可以是任何东西

打开工作簿时，应使用vba将逗号分隔的列与值一起下拉

我对这个宏非常陌生。我已经写了下面的代码。对于单电池来说，它工作得很好。但是，我想在一定范围内这样做，比如从H1到最后一个的“H”列。如何做到这一点？你能帮我吗

Private Sub Workbook_Open()
    AddListValidation "Task", "A1", "A2"
End Sub


Sub AddListValidation(sheet, cellSource As Range, cellTarget As Range)
    Dim Lastrow As Integer
    Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row


    txt = ActiveWorkbook.Worksheets(sheet).Range(cellSource).Value
    ActiveWorkbook.Worksheets(sheet).Range(cellTarget) = "Select your values here"
    With ActiveWorkbook.Worksheets(sheet).Range(cellTarget).Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:="xxx,yyy,zzz"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

---

您需要一个循环来为每一行调用

AddListValidation

。此外，当您将完整的限定范围作为参数而不是地址时，工作表不需要参数

建议在VBA中使用

Integer

没有任何好处。特别是对于行计数，因为Excel的行数超过了

Integer

所能处理的行数

Option Explicit

Private Sub Workbook_Open()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Tabelle4")

    Dim LastRow As Long 'always use long instead of integer
    LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    Dim iRow As Long
    For iRow = 2 To LastRow
        AddListValidation ws.Cells(iRow, "A"), ws.Cells(iRow, "B")
    Next iRow
End Sub


Sub AddListValidation(cellSource As Range, cellTarget As Range)
    cellTarget.Value = "Select your values here"
    With cellTarget.Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:=cellSource.Value
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

---

你的问题到底是什么，你一个都没问？这不是免费的代码编写服务。你需要自己动手，如果你陷入困境，展示你已经拥有的代码并向它提问。我知道这不是免费的代码服务。我的系统有问题。正在尝试编辑我的帖子。您要做的是拆分第一列中的值。这样做是可能的。我想你可能会发现将代码集成到你生成的代码中是有用的，它工作得很好。但是当我做了一些更改并关闭excel时。如果我试着打开同一张表，它将修复excel，并将该表移动到下一张表。下拉列表值也不会出现。嗯，修复意味着您的Excel文件可能已损坏。这与代码无关。尝试制作一个新工作簿，并将所有内容复制/复制到新工作簿中。或者尝试以二进制XLSB格式保存（通常更稳定）。不，总共有8张。每一个都有不同的功能。实际上，在这张表中还有其他一些列。但是，现在我对这组代码进行了注释，并进行了保存并再次打开。它按预期工作。我在工作表_Activate（）中这样做。“它会导致pbm吗？”什么？对不起，我不明白你的意思。