请教下拉列表的宏代码
我想得到工作表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 & ","NextWith Range("B2").Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=XEnd WithEnd 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 WithEnd Sub
[解决办法]
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.
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