Как превратить список проверки из ячейки в список с помощью VBA

Question

У меня есть лист, в который мне нужно вставить данные в соответствии со списками проверки на этих листах. На листе есть много столбцов, каждый со своим собственным списком проверки данных - некоторые записываются непосредственно как "yes;no" другие являются ссылками "='$$VALUES$$'!$IJ$1:$IJ$12".

Мне нужно найти способ добавить каждый элемент вкаждый список в массив. Используя приведенный ниже код, я смог найти ссылки выше.

Debug.Print Cells(2, 6).Validation.Formula1

Есть ли какой-нибудь элегантный способ сохранить выходные данные в виде списка, содержащего каждый допустимый ввод. Моя единственная идея на данный момент состоит в том, чтобы сначала проверить, какой тип вывода я получаю, а затем, если это форма списка «да; нет», затем искать число;а затем разделить его по элементам. И в случае, если это ссылка на диапазон листа, разделите его на лист и диапазон и преобразуйте этот диапазон в массив.

Answer 1

Я был немного ограничен во времени, поэтому я сам решил сделать неэлегичное решение. Размещение здесь, если кто-то столкнется с той же проблемой.

Sub ValidList()
Dim strFormula As String
Dim intLastSemi As Integer
Dim intCurSemi As Integer
Dim intSemi As Integer
Dim aryList() As Variant
Dim intLen As Integer
Dim blnCont As Boolean

Dim strSheet As String
Dim strRange As String
Dim intSplit As Integer

Dim ws As Worksheet
Dim rng As Range
Dim e As Variant

Dim Row As Integer
Dim Col As Integer

'This is just an example, turning it into a fucntion based on row and col later
'so now my test validation list is just in A1
Row = 1
Col = 1

strFormula = Cells(Row, Col).Validation.Formula1
intLen = Len(strFormula)
If InStr(1, strFormula, "=") Then 'Sheet reference
   intSplit = InStr(1, strFormula, "!")
   strSheet = Right(Left(strFormula, intSplit - 1), intLen - intSplit - 3)
   strRange = Right(strFormula, intLen - intSplit)

   Set ws = Worksheets(strSheet)
   Set rng = ws.Range(strRange)

   aryList() = rng

ElseIf Not InStr(1, strFormula, ";") Then 'Hardcoded list
    intSemi = 0
    intLastSemi = 0
    blnCont = True
    While blnCont
        intCurSemi = InStr(intLastSemi + 1, strFormula, ";")
        If intCurSemi <> 0 Then
            intSemi = intSemi + 1
            ReDim Preserve aryList(intSemi)
            aryList(intSemi) = Right(Left(strFormula, intCurSemi - 1), intCurSemi - intLastSemi - 1)
            intLastSemi = intCurSemi
        ElseIf intCurSemi = 0 Then
            intSemi = intSemi + 1
            ReDim Preserve aryList(intSemi)
            aryList(intSemi) = Right((strFormula), intLen - intLastSemi)
            blnCont = False
        End If
    Wend
End If

'For my attempt at passing the array to a function
'For Each e In aryList
'    MsgBox e
'Next
'ReDim ValidList(UBound(aryList))
'ValidList = aryList

End Sub

Answer 2

Как то так, сделаю это. Я бы установил диапазон вместо использования activecell, а также проверил бы наличие проверки, чтобы уменьшить ваши ошибки.

Sub get_val_lists()

Dim arrOutput() As Variant

If Left(ActiveCell.Validation.Formula1, 1) <> "=" Then
    arrOutput = Split(ActiveCell.Validation.Formula1, ",")
Else
    arrOutput = Application.Transpose( _
                Range(Mid(ActiveCell.Validation.Formula1, 2)).value)
End If

End Sub