Можно ли исправить или объявить тип для ячейки в VBA? - PullRequest
3 голосов
/ 16 марта 2012

Я знаю, что в VBA мы можем сделать

Cells(4, 2).Value = 100      'the cell is an integer
Cells(4, 2).Value = True     'the cell is Boolean
Cells(4, 2).Value = "abc"    'the cell is Text

Можно ли исправить или объявить тип ячейки, например, пусть Cells(4,2) принимает только логическое значение, такое, что присваивает Integer или Text до Cells(4, 2) выдает ошибку?

Ответы [ 3 ]

5 голосов
/ 16 марта 2012

[РЕДАКТИРОВАТЬ Это решение может быть реализовано из VBA, но его нельзя использовать из VBA, т. Е. Не может помешать пользователю VBA установить значение ячейки равным чему-либо (хотя и не вручную в листе Excel).Не уверен, что ОП на самом деле хочет. ]

Использовать проверку данных.

Вы можете сделать это через VBA:

Range("A1").Validation.Add Type:=xlValidateList, Formula1:="TRUE,FALSE"

или вручную:(В Excel 2003: Данные> Проверка ...)

enter image description here

Теперь в ячейку A1 можно вводить только логическое значение TRUE или FALSE.Если вы попытаетесь ввести что-то еще, например, число:

enter image description here

Используя проверку данных, вы можете также ограничить ячейку, чтобы принимать только цифры, только целые числа, текст определенной длиныв принципе ничего.Например, чтобы принимать только текст и , а не чисел, вы должны использовать Разрешить: Пользовательский, Формула: =NOT(ISNUMBER(A1)).

4 голосов
/ 16 марта 2012

Я второе предложение JFC по использованию проверки данных.

Чтобы проверить его, поместите этот код в модуль ( ПРОБОВАН И ИСПЫТАНО )

Sub Sample()
    With Sheets("Sheet1").Range("A1")
        .Validation.Delete
        .Validation.Add Type:=xlValidateList, Formula1:="TRUE,FALSE"
        .Value = "SID"
    End With
End Sub

и этов соответствующем листе

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Whoa

    If Not Intersect(Target, Range("A1")) Is Nothing Then
        Application.EnableEvents = False

        On Error Resume Next
        If Not Target.SpecialCells(xlCellTypeSameValidation).Cells.Count < 1 Then
            Dim currentValidation As Excel.Validation
            Set currentValidation = Target.Validation

            If currentValidation.Type = xlValidateList Then
                '~~> I am using INSTR. If you want you can split it using "," as delim 
                '~~> and check for the value.
                If Not InStr(1, currentValidation.Formula1, Target.Value, vbTextCompare) Then
                    MsgBox "Incorrect Value"
                    Target.ClearContents
                End If
            End If
        End If
        On Error GoTo 0
    End If
LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Теперь попробуйте запустить Sub Sample() в модуле.

4 голосов
/ 16 марта 2012

Если вы действительно хотите, чтобы тип ячейки был указан, вы не можете. Насколько мне известно, все ячейки в VBA содержат разные типы данных.

Если вы имеете в виду тип данных варианта, то, конечно, вы можете сделать это так или иначе. Вот предложение, это немного быстро и грязно, но это работает. Вы должны будете поместить это в свой модуль кода рабочего листа. Обратите внимание, что он не проверяет, пересекает ли ваш диапазон bool, int range, что угодно, что может вызвать у вас некоторые проблемы.

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo handler

    Dim cell As Range, _
        boolRng As Range, _
        intRng As Range

    Set boolRng = Union(Sheet1.Range("A1:B2"), Sheet1.Range("E:E"))
    Set intRng = Union(Sheet1.Range("B7:K12"), Sheet1.Range("M:M"))

    If Not Intersect(Target, boolRng) Is Nothing Then
        For Each cell In Intersect(Target, boolRng)
            If cell.Value <> "" Then
                cell.Value = CBool(cell.Value)
            End If
        Next cell
    End If

    If Not Intersect(Target, intRng) Is Nothing Then
        For Each cell In Intersect(Target, intRng)
            If cell.Value <> "" Then
                cell.Value = CInt(cell.Value)
            End If
        Next cell
    End If

    Exit Sub

handler:
    Select Case Err.Number
        Case 13 'Type mismatch, raised when cint/cbool/c*** fails
            cell.Value = ""
            Resume Next
        Case Else
            Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
    End Select

End Sub

Редактировать: Замечу, что вы хотите вызвать ошибку, если значение назначено неправильно, вы можете сделать это в разделе обработки ошибок. Вместо

Cell.value = ""
Resume Next

Вы можете использовать

Err.Raise ISuggestAnEnumForErrorNumbers, "Sheet1.Worksheet_Change(Event)", "Attempted to assign wrong type to cell."
...