excel - 如何从excel下拉列表中提取项目？

Question

我有许多包含大量项目（集合中的元素）的下拉列表的 xls 文件，我希望将它们复制到文本编辑器中。

任何想法或信息都会对我有所帮助。

Answer 1

打开要从中列出列表的工作簿，将其粘贴到新模块中并运行它（ALTF11→<kbd>ALT I→<kbd>ALT M→<kbd>F5）。它循环遍历文本文件中的控件和列表下拉列表（在与工作簿相同的路径中）并在记事本中打开它。

Sub ListAllCombos()
'loop through active workbook: sheets -> shapes -> dropdowns -> input ranges
Dim ws As Worksheet, shp As Shape, c As Range, r As Range
Dim x As Integer, strOut As String
strOut = "   Workbook Name: " & Application.ActiveWorkbook.FullName & vbCrLf
For Each ws In ActiveWorkbook.Worksheets
    strOut = strOut & "--Worksheet Name: " & ws.Name & vbCrLf
    For Each shp In ws.Shapes
        If shp.FormControlType = xlDropDown Then
            x = x + 1
            strOut = strOut & "--DropDown Name: " & shp.Name & vbCrLf
            Set r = Range(shp.ControlFormat.ListFillRange)
            For Each c In r
                strOut = strOut & Worksheets(ws.Name).Range(c.Address) & vbCrLf
            Next c
            strOut = strOut & vbCrLf
        End If
    Next shp
Next ws

If x = 0 Then
    MsgBox "No dropdowns."
    Exit Sub
End If
strOut = strOut & "(" & x & " dropdowns)" & vbCrLf

'write to text file & open in Notepad
Dim fName, RetVal
fName = Application.ActiveWorkbook.Path & "\DropDowns (" & Application.ActiveWorkbook.Name & ").txt"
If Dir(fName) <> "" Then If MsgBox("Existing file will be replaced.", vbOKCancel, "Replace") = vbCancel Then Exit Sub
Open fName For Output As #1
Write #1, strOut & vbCrLf & Now()
Close #1
If MsgBox("File created:" & vbCrLf & x & " listboxes saved in file: " & fName, vbOKCancel, "Open list in Notepad?") = vbCancel Then Exit Sub
RetVal = Shell("C:\WINDOWS\Notepad.EXE " & fName, 1)
'Debug.Print strOut
End Sub