首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VBA >

请问下拉列表的宏代码

2012-04-04 
请教下拉列表的宏代码我想得到工作表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

[解决办法]
代码是对的,稍微修改一下:

VBScript code
Sub 列表项目()For Each m In Range("B3:B20")    X = X & m & ","NextWith Range("B2").Validation  .Delete  .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=XEnd WithEnd 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 WithEnd 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 shEnd 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 

热点排行