当前位置: 代码迷 >> VBA >> 请问上拉列表的宏代码
  详细解决方案

请问上拉列表的宏代码

热度:4044   发布时间:2013-02-26 00:00:00.0
请教下拉列表的宏代码
我想得到工作表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
  相关解决方案