如何编写将从输入创建下拉列表的程序，并使用下拉列表填充另一个工作表中的列

Question

我是VBA的新手，目前知道如何使用＆＃34;记录宏来创建宏＃34;选项。我需要对在VBA中执行多个步骤的内容进行编码。

我将有一个未知数量的列，我需要程序通过并检查第二行是否有值。（这些列和行将从用户输入，因此列数或条目数行未知）。

每列下的值是用户稍后可能为该特定变量选择的类别。所以在Sheet 1中有一个变量＆＃34; Sex＆＃34;它下面会有一行说＆＃34;女性＆＃34;在那句话下的另一行＆＃34;男性＆＃34;。这些必须被制作成一个下拉列表并粘贴在另一个工作表（Sheet2）下，其中相同的列名（Sex）现在将在它们下面显示。

采取的步骤：

1）IF栏（i）的第2行不为空

2）然后将其下面的所有行定义为列表并下拉列表

3）然后将此下拉列表粘贴到与另一张表中的列（i）名称匹配的列下

SHEET 1（我拥有的）

Age      | Sex    | Race   | Height 
------------------------------------
[EMPTY]  |Female  |Asian   |[EMPTY]     
[EMPTY]  |Male    |Black   |[EMPTY]          
[EMPTY]  |[EMPTY] |Hispanic|[EMPTY]          
[EMPTY]  |[EMPTY] |Native A|[EMPTY]          
[EMPTY]  |[EMPTY] |White   |[EMPTY] 
[EMPTY]  |[EMPTY] |Other   |[EMPTY] 

第2页（我想要的）

AGE      | Sex               | Race                | Height
------------------------------------------------------------
[EMPTY]  | [dropdown of sex] | [dropdown of race]  |[EMPTY]

Answer 1

首先，您有工作表A和工作表B。

表B：

+----+-----------+---+---------------+----+---+-------------+--------+---+-------------+----------+---+--------------+----+
|    |     A     | B |       C       | D  | E |      F      |   G    | H |      I      |    J     | K |      L       | M  |
+----+-----------+---+---------------+----+---+-------------+--------+---+-------------+----------+---+--------------+----+
|  1 |           |   | myAge         |  5 |   | mySex       | Female |   | myRace      | Asian    |   | myHeight     | 25 |
|  2 | SheetName |   | B!$D$1:$D$101 |  6 |   | B!$G$1:$G$2 | Male   |   | B!$J$1:$J$6 | Black    |   | B!$M$1:$M$66 | 30 |
|  3 | B         |   |               |  7 |   |             |        |   |             | hispanic |   |              | 35 |
|  4 |           |   |               |  8 |   |             |        |   |             | Native A |   |              | 40 |
|  5 |           |   |               |  9 |   |             |        |   |             | White    |   |              | 45 |
|  6 |           |   |               | 10 |   |             |        |   |             | Other    |   |              | 50 |
|  7 |           |   |               | 11 |   |             |        |   |             |          |   |              | 55 |
|  8 |           |   |               | 12 |   |             |        |   |             |          |   |              | 60 |
|  9 |           |   |               | 13 |   |             |        |   |             |          |   |              | 65 |
| 10 |           |   |               | 14 |   |             |        |   |             |          |   |              | 70 |
| 11 |           |   |               | 15 |   |             |        |   |             |          |   |              | 75 |
| 12 |           |   |               | 16 |   |             |        |   |             |          |   |              | 80 |
| 13 |           |   |               | 17 |   |             |        |   |             |          |   |              | 85 |
| 14 |           |   |               | 18 |   |             |        |   |             |          |   |              | 90 |
+----+-----------+---+---------------+----+---+-------------+--------+---+-------------+----------+---+--------------+----+

将公式放在每个单元格中，如下所示：

+----+---------------+-------------------------------------------------------------------------------------------+
| C2 | B!$D$1:$D$101 | =ADDRESS(ROW(D1),COLUMN(D1),,,SheetName)&":"&ADDRESS(ROW(D1)+COUNTA(D:D)-1,COLUMN(D1),,,) |
| F2 | B!$G$1:$G$2   | =ADDRESS(ROW(G1),COLUMN(G1),,,SheetName)&":"&ADDRESS(ROW(G1)+COUNTA(G:G)-1,COLUMN(G1),,,) |
| I2 | B!$J$1:$J$6   | =ADDRESS(ROW(J1),COLUMN(J1),,,SheetName)&":"&ADDRESS(ROW(J1)+COUNTA(J:J)-1,COLUMN(J1),,,) |
| L2 | B!$M$1:$M$66  | =ADDRESS(ROW(M1),COLUMN(M1),,,SheetName)&":"&ADDRESS(ROW(M1)+COUNTA(M:M)-1,COLUMN(M1),,,) |
+----+---------------+-------------------------------------------------------------------------------------------+

现在你用这种方式设置每个名字：

按New...

使用以下方法设置范围名称：

+---+----+-----------+-------------------+
|   | A  |     B     |         C         |
+---+----+-----------+-------------------+
| 1 | A2 | SheetName | =B!$A$3           |
| 2 | C1 | myAge     | =INDIRECT(B!$C$2) |
| 3 | F1 | mySex     | =INDIRECT(B!$F$2) |
| 4 | I1 | myRace    | =INDIRECT(B!$I$2) |
| 5 | L1 | myHeight  | =INDIRECT(B!$L$2) |
+---+----+-----------+-------------------+

表A：

+---+-----+-----+------+--------+
|   |  A  |  B  |  C   |   D    |
+---+-----+-----+------+--------+
| 1 | Age | Sex | Race | Height |
| 2 |     |     |      |        |
| 3 |     |     |      |        |
| 4 |     |     |      |        |
| 5 |     |     |      |        |
| 6 |     |     |      |        |
+---+-----+-----+------+--------+

在常规模块中：

Sub addComboBox()
    Dim rngHeaders As Range
    Dim i As Range
    Dim r
    Dim c
    Dim Nm As String
    Dim n As Name

    '1
    'take all the cells in the first row
    'just the headers

    r = 1 'is just the fist row!
    c = Range("A1").End(xlToRight).Column

    Set rngHeaders = Range(Cells(1, 1), Cells(r, c))

    For Each i In rngHeaders
        Nm = "my" & i.Value
        For Each n In ThisWorkbook.Names
            If Nm = n.Name Then
                With i.Offset(1, 0).Resize(20, 1).Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=" & Nm
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .InputTitle = ""
                    .ErrorTitle = ""
                    .InputMessage = ""
                    .ErrorMessage = ""
                    .ShowInput = True
                    .ShowError = True
                End With
            End If
        Next n
    Next i
End Sub

注意：

对于表单A中的每个标题，您需要在表单B中使用相同的名称加上“my”进行设置，这样：myAge， mySex，等等。

本教程将指导您在该标题中设置带有下拉菜单的列表，如果要将下拉菜单设置为更多单元格（而不仅仅是每个标题的第二个单元格），则需要将此行替换为{{ 1}}这个i.Offset(1, 0).Validation，其中With i.Offset(1, 0).Resize(20, 1).Validation是您要设置的行数，结果将是：

20

Answer 2

这里有一些教程可以帮助您入门。我遗漏了一些你要解决的问题...不确定你的编码有多好，但这是基本的想法。

步骤1.尝试手动完成。您需要使用“数据”菜单，“数据验证”按钮。验证类型是List。对于验证源，单击源文本框右侧的按钮，然后从sheet1中选择单元格。

步骤2.再次手动执行，但这次使用Record Macro生成代码。看起来应该是这样的：

Selection.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= xlBetween, Formula1:="=Sheet1!$A$2:$A$3"

步骤3.获取宏代码并将其放入子代码中。

Sub SetUpOneValidator
    Selection.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= xlBetween, Formula1:="=Sheet1!$A$2:$A$3"
End Sub

步骤4.向sub添加参数，使其适用于任何列

Sub SetUpOneValidator(byval column as integer, byval count as integer)
    Dim s as string
    s = ComputeFormulaForRange(column, count) 'You'll have to write this yourself
    Sheets("Sheet2").cells(2, column).Validdation.Add Type:=xlValidateList, Formula1:=s
End Sub

步骤5.写一个“外部”子来为每列调用你的子

Sub DoMyWork
    Dim x as integer, n as integer
    while x <= Sheets("sheet1").UsedRange.Columns.Count
        n = DetectRowCountForColumn(x) 'You'll have to write this yourself!
        SetUpOneValidator x, n
        x = x + 1
    Wend
End Sub

Answer 3

这里有点＆＃34;一般＆＃34;一段代码（评论）：

Option Explicit

Sub AddDropDowns()
    Dim cell As Range
    Dim iDropDown As Long

    With Worksheets("DropDownData") '<--| reference "Data" sheet
        For Each cell In .Range("A2", .Cells(2, .Columns.Count).End(xlToLeft)).SpecialCells(XlCellType.xlCellTypeConstants) '<--| loop through its 2nd(!) row non empty cells
            '          |         DropDown      | dropdown |      dropdown        |                      dropdown                                                             |
            '          |         sheet         | counter  |      header          |                validation formula                                                         |
            AddDropDown Worksheets("DropDowns"), iDropDown, cell.Offset(-1).value, "='" & .Name & "'!" & cell.Resize(WorksheetFunction.CountA(cell.EntireColumn) - 1).Address '<--| add current cell column dropdown in "DropDowns" sheet
        Next cell
    End With
End Sub

Sub AddDropDown(sht As Worksheet, dropDownCounter As Long, header As String, validationFormula As String)
    With sht.Range("A1").Offset(, dropDownCounter) '<--| reference passed sheet row 1 passed column
        .Cells(1, 1) = header '<--| write header
        With .Cells(2, 1).Validation '<--| reference 'Validation' property of cell 1 row below currently referenced one
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=validationFormula
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    End With
    dropDownCounter = dropDownCounter + 1
End Sub