获取某个单元格的数据有效性列表

边缘码农

获取某个单元格的数据有效性列表

子函数代码如下：

1. Function GetDataValidationList(OneRng As Range) As String
   
2.     '--------------------------------------------
   
3.     '  获取某个单元格设置的数据有效性列表
   
4.     '  参数：
   
5.     '       OneRng，要获取数据有效性的单个单元格
   
6.     '  返回值：
   
7.     '       数据有效性的文本列表，以半角字符“,”间隔
   
8.     '--------------------------------------------
   
9.     '设置数据有效性，有2种方式：
   
10.     '   1、直接在数据有效性数据验证窗口的“来源”输入框中输入。
    
11.     '       此时：系统强制使用半角字符“,”间隔，类似于：1,2,3,4,5,6,7,8
    
12.     '   2、在数据有效性数据验证窗口的“来源”输入框中输入公式。
    
13.     '       使用公式则有以下情况：
    
14.     '       （1）、公式引用的单元格来自本表，此时的设置公式类似于：=$H$10:$H$14
    
15.     '       （2）、公式引用的单元格来自其他表，此时的设置公式类似于：=sheet1!$A$1:$A$8
    
16.     '--------------------------------------------
    
17.     ' 边缘码农  2024.07.10
    
18.     '--------------------------------------------
    
19.     ' 定义变量
    
20.     Dim DVFormula As String '数据有效性设置文本
    
21.     Dim LsArr() As String ' 临时分割数组
    
22.     Dim Sht As Worksheet '工作表对象
    
23.     Dim Rng As Range '临时单元格对象
    
24.     '--------------------------------------------
    
25.     On Error Resume Next
    
26.     DVFormula = OneRng.Cells(1, 1).Validation.Formula1
    
27.     If Err.Number > 0 Then
    
28.         GetDataValidationList = "未设置数据有效性"
    
29.         Exit Function
    
30.     End If
    
31.     If DVFormula <> "" Then
    
32.         If Left(DVFormula, 1) = "=" Then
    
33.             ' 数据有效性的第一个字符是=，引用公式
    
34.             DVFormula = Mid(DVFormula, 2, Len(DVFormula) - 1) ' 去掉开头的=
    
35.             LsArr = Split(DVFormula, "!")
    
36.             Set Sht = ActiveSheet
    
37.             If UBound(LsArr()) > 0 Then
    
38.                 ' 分割后数组成员大于0，有两个成员，第1个成员是工作表名称
    
39.                 Set Sht = Sheets(LsArr(0))
    
40.             End If
    
41.             DVFormula = ""
    
42.             For Each Rng In Sht.Range(LsArr(UBound(LsArr)))
    
43.                 If Rng <> "" Then
    
44.                     DVFormula = DVFormula & Rng & ","
    
45.                 End If
    
46.             Next
    
47.             DVFormula = Left(DVFormula, Len(DVFormula) - 1)
    
48.         End If
    
49.         GetDataValidationList = DVFormula
    
50.     End If
    
51. End Function
    

复制代码

调用方式：

1. MsgBox GetDataValidationList(Range("a3"))

复制代码

或者：

1. MsgBox GetDataValidationList(Range("a3:k5"))

复制代码

当参数是单元格区域时，只取单元格区域的第一个单元格。

ykcbf1100

建议楼主上个实例。

dgseg

ykcbf1100 发表于 2024-7-10 09:39
建议楼主上个实例。

老师，麻烦老师能给我这个表格写个程序吗，谢谢了，
https://club.excelhome.net/threa ... tml?_dsign=799c8ea9

ykcbf1100

dgseg 发表于 2024-7-10 09:57
老师，麻烦老师能给我这个表格写个程序吗，谢谢了，
https://club.excelhome.net/thread-1696310-1-1.ht ...

我看下，看能不能做。

dgseg

dgseg 发表于 2024-7-10 09:57
老师，麻烦老师能给我这个表格写个程序吗，谢谢了，
https://club.excelhome.net/thread-1696310-1-1.ht ...

老师是这个附件，刚才上传错了，麻烦老师给看看

dgseg

ykcbf1100 发表于 2024-7-10 10:02
我看下，看能不能做。

老师是这个附件，刚才上传错了，麻烦老师给看看

新月统计表1.rar

24.04 KB, 下载次数: 0

边缘码农

ykcbf1100 发表于 2024-7-10 09:39
建议楼主上个实例。

单位的电脑装了加密软件。
所以最近我从不上传文件，上传的都是加密的文件，其他人打不开，没有意义。

ykcbf1100

dgseg 发表于 2024-7-10 10:10
老师是这个附件，刚才上传错了，麻烦老师给看看

新月统计表1.rar

我看了一下，还没搞清楚要去做什么。
你这个写代码也比较费时的，适合付费定制，一对一沟通完成。

ykcbf1100

边缘码农 发表于 2024-7-10 10:14
单位的电脑装了加密软件。
所以最近我从不上传文件，上传的都是加密的文件，其他人打不开，没有意义。

好的，我知道了。

dgseg

ykcbf1100 发表于 2024-7-10 10:02
我看下，看能不能做。

可以把表2.表3的数据合成一个表