请问下拉列表的宏代码

请教下拉列表的宏代码
我想得到工作表n3:n21单元格区域的内容为列表项目,下拉箭头设置在b2单元格,请老师指教修改下面的宏代码.谢谢!!!

Sub 列表项目()
For m = 1 To 50
X = X & m & ","
Next m
With Range("B2").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=X
End With
End Sub

------解决方案--------------------
代码是对的，稍微修改一下：

VBScript code

Sub 列表项目()
For Each m In Range("B3:B20")
    X = X & m & ","
Next
With Range("B2").Validation
  .Delete
  .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=X
End With
End Sub

------解决方案--------------------

VB code


Sub 列表项目()
    Dim m, X As String
    For Each m In Range("N3:N21")
        X = X & m & ","
    Next m
    With Range("B2").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=X
    End With
End Sub

------解决方案--------------------

VB code


Sub 列表项目()
    Dim m, X As String
    For Each m In Sheets("分项工程汇总表").Range("N3:N21")
        X = X & m & ","
    Next m
    
    Dim sh
    For Each sh In Worksheets
        If sh.Name <> "分项工程汇总表" Then
            With sh.Range("B2").Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=X
            End With
        End If
    Next sh
End Sub

------解决方案--------------------
1.
Sub 复制多工作表()
 Dim i As Byte
 For i = 1 To InputBox("请输入复制工作表的数量:", "", 1)
 Sheets("分项工程汇总表").Copy After:=Sheets(Sheets.Count)
 ActiveSheet.Name = "新表" & Format(i, "0")
 ActiveSheet.Columns("N:N").Delete    '删除第N列，可以自己加
 Next i
End Sub

------解决方案--------------------

2.

VB code


    Dim xlApp As Excel.Application
    Dim xlBook As Workbook
    Dim xlSheet As Worksheet
    
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Open(ThisWorkbook.Path & "\列表工作簿.xls")    '自己改文件名
    xlApp.Visible = False
    Set xlSheet = xlBook.Sheets("列表工作表")   '自己改表名称
    
    Dim m, X As String
    For Each m In xlSheet.Range("D1:D" & xlSheet.[D65536].End(xlUp).Row)
        If Len(m) > 0 Then X = X & m & "," Else Exit For
    Next m
    xlBook.Close
    Set xlApp = Nothing
    
    Dim sh
    For Each sh In Worksheets
        If sh.Name <> "分项工程汇总表" Then
            With sh.Range("B2").Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=X
            End With
        End If
    Next sh

请问下拉列表的宏代码

相关推荐