Excel VBA创建下拉列表

分析学习者

我正在尝试编写一些代码，以创建一个下拉列表，该列表包含文件夹中具有特定文件扩展名的所有文件。初始代码在这里：

Dim FSOLibrary As Object
Dim FSOFolder As Object
Dim FSOFile As Object
Dim fp As String
Dim i As Integer    

fp = Environ("UserProfile") & "\OneDrive\Desktop\Test"

Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
Set FSOFolder = FSOLibrary.GetFolder(fp)
Set FSOFile = FSOFolder.Files

i = 1

For Each FSOFile In FSOFile
    If FSOFile Like "*.txt*" Then
        'just put the name into column B for testing
        Range("B" & i).Value = FSOFile.Name
        i = i + 1
    End If    
Next FSOFile

显然，我需要在代码中添加数据验证部分，但是我不确定如何最好地构造它。文件数是动态的。

我正在考虑将与所需文件扩展名类型匹配的所有文件放入数组，然后将数组的每个条目写入数据验证部分？

我已经看到Dir（）使用了很多，但是我不完全理解它，所以选择使用fso。

维塔塔

使用Excel范围

建筑物下拉菜单通常由两部分组成：

查找范围，该范围用于值列表
将这些值写入字符串，并用逗号分隔

下面的代码正是这样做的：

首先，它从第1行endRow到第row行循环到这些行中的值。将它们写入字符串，validationString并在每个单元格值后添加逗号
最后一个逗号无用，因此将其与空格一起删除： validationString = Left(validationString, Len(validationString) - 2)
将validationString被传递到.Validation单元格“ A1”的属性。

Sub TestMe()

    Dim wks As Worksheet: Set wks = Worksheets(1)
    Dim endRow As Long: endRow = LastRow(wks.Name, 3)
    Dim validationString As String
    Dim i As Long

    For i = 1 To endRow
        validationString = validationString & wks.Cells(i, "C") & ", "
    Next i

    validationString = Left(validationString, Len(validationString) - 2)

    With Worksheets(1).Cells(1, "A").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                        Operator:=xlBetween, _
                        Formula1:=validationString
    End With

End Sub


Function LastRow(wsName As String, Optional columnToCheck As Long = 1) As Long
    Dim ws As Worksheet
    Set ws = Worksheets(wsName)
    LastRow = ws.Cells(ws.Rows.Count, columnToCheck).End(xlUp).Row
End Function

不写范围

这里的“技巧”是从循环中获取数据并将其写入列表，同时循环通过fsoFolder.Files：

Sub TestMe()

    Dim filePath As String
    filePath = Environ("UserProfile") & "\Desktop\QA"
    Dim fsoLibrary As Object: Set fsoLibrary = CreateObject("Scripting.FileSystemObject")
    Dim fsoFolder As Object: Set fsoFolder = fsoLibrary.GetFolder(filePath)
    Dim fsoFile As Object

    Dim validationString As String
    For Each fsoFile In fsoFolder.Files
        If fsoFile Like "*.txt*" Then
            validationString = validationString & fsoFile.Name & ", "
        End If
    Next fsoFile

    validationString = Left(validationString, Len(validationString) - 2)

    With Worksheets(1).Cells(1, "A").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                        Operator:=xlBetween, _
                        Formula1:=validationString
    End With

End Sub

本文收集自互联网，转载请注明来源。

如有侵权，请联系 [email protected] 删除。