请问上拉列表的宏代码

2013-01-07

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

请教下拉列表的宏代码
我想得到工作表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
[解决办法]
代码是对的，稍微修改一下：

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

[解决办法]


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

将N3:N21内容设为列表项目。
[解决办法]


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.


    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

热点排行

VBA

请问上拉列表的宏代码