读书人

请问上拉列表的宏代码

发布时间: 2013-01-07 10:02:25 作者: rapoo

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

热点推荐