Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 4787|回复: 8

[已解决]如何同时设置整个工作簿各个工作表的下拉列表

[复制链接]
发表于 2014-7-23 16:00 | 显示全部楼层 |阅读模式
如题,,跪求解决方法。。。小女纸要弄项目表,好多分表,怎么同时设置整个工作簿各个工作表的下拉列表呢?每个工作表的固定某列的下拉列表都是一样的选项,如何同时设置?
求大神帮忙!谢谢!
最佳答案
2014-7-23 17:07
本帖最后由 爱疯 于 2014-7-23 17:12 编辑



Sub test()
    Dim s As Worksheet, r As Range
    Application.ScreenUpdating = False

    '1)在第一个工作表的S1,建辅助单元格
    Set r = Sheets(1).[s1]
    With r.Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:="已签约,拟签约,谈判中,意向"
    End With
    r.Copy

    '2)循环粘贴
    For Each s In Sheets
        With s
            .Range("k2:k" & .Range("k65536").End(xlUp).Row).PasteSpecial Paste:=xlPasteValidation
        End With
    Next

    '3)删除辅助单元格中的有效性
    r.Validation.Delete
End Sub
华北项目信息表7月17日整理(全)3.rar (43.52 KB, 下载次数: 18)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2014-7-23 16:18 | 显示全部楼层
先上传附件吧,不然大家还是不好明白需求,那样就会等很久。。。。。。。。有3个分表就好了
回复

使用道具 举报

 楼主| 发表于 2014-7-23 16:29 | 显示全部楼层
谢谢二楼提醒,附件中一个工作簿中有很多表,现在我只设置了“任凤弟”这个表K列的下拉列表,要求后面所有的表的K列都和“任凤弟”表K列的下拉列表一样,请问怎么设置?我还有上百个表,要一个一个去设置工作量真的很大,请大家帮帮忙。。

华北项目信息表7月17日整理(全).rar

29.58 KB, 下载次数: 5

回复

使用道具 举报

发表于 2014-7-23 17:05 | 显示全部楼层
  1. Sub test()
  2. Dim i As Integer
  3. For i = 1 To Sheets.Count
  4. With Sheets(i)
  5. Set Rng = .Range("K2:K" & .Cells(Rows.Count, "K").End(3).Row)
  6.     With Rng.Validation
  7.         .Delete
  8.         .Add 3, 1, 1, "已签约,拟签约,谈判中,意向"
  9.     End With
  10. End With
  11. Next
  12. End Sub
复制代码
试试看看

华北项目信息表7月17日整理(全).rar

44.09 KB, 下载次数: 18

评分

参与人数 1 +1 收起 理由
rachel005t + 1 很给力!

查看全部评分

回复

使用道具 举报

发表于 2014-7-23 17:07 | 显示全部楼层    本楼为最佳答案   
本帖最后由 爱疯 于 2014-7-23 17:12 编辑



Sub test()
    Dim s As Worksheet, r As Range
    Application.ScreenUpdating = False

    '1)在第一个工作表的S1,建辅助单元格
    Set r = Sheets(1).[s1]
    With r.Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:="已签约,拟签约,谈判中,意向"
    End With
    r.Copy

    '2)循环粘贴
    For Each s In Sheets
        With s
            .Range("k2:k" & .Range("k65536").End(xlUp).Row).PasteSpecial Paste:=xlPasteValidation
        End With
    Next

    '3)删除辅助单元格中的有效性
    r.Validation.Delete
End Sub
华北项目信息表7月17日整理(全)3.rar (43.52 KB, 下载次数: 18)

评分

参与人数 1 +1 收起 理由
rachel005t + 1 很给力!

查看全部评分

回复

使用道具 举报

发表于 2014-7-23 17:19 | 显示全部楼层
开始,我也是和4楼那样,

每次用 单元格区域.Validation 设置时就出错。。。。。。。没多找原因(应该是自己哪儿的问题),改为复制的方式了。

还是直接设置好些!
回复

使用道具 举报

发表于 2014-7-23 18:40 | 显示全部楼层
爱疯 发表于 2014-7-23 17:19
开始,我也是和4楼那样,

每次用 单元格区域.Validation 设置时就出错。。。。。。。没多找原因(应该是 ...

.Delete
嘿嘿
回复

使用道具 举报

 楼主| 发表于 2014-7-24 09:27 | 显示全部楼层
易安1 发表于 2014-7-23 17:05
试试看看

谢谢帮忙,感激不尽。。。好人一生富贵平安~~{:091:}
回复

使用道具 举报

 楼主| 发表于 2014-7-24 09:28 | 显示全部楼层
爱疯 发表于 2014-7-23 17:07
Sub test()
    Dim s As Worksheet, r As Range
    Application.ScreenUpdating = False

感谢老师,我马上试一下。。。
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-28 23:52 , Processed in 0.599106 second(s), 15 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表