Excel вставляет значение ячейки в функцию и возвращает новое значение (не формула)

Question

Я пытаюсь написать макрос, который перезапишет все значения в столбце, вставив их в функцию, а затем вставив в результат.Когда я пытаюсь это сделать, моя функция думает, что вставленная переменная является текстовой, а не переменной.Я не уверен, как заставить это признать это как переменную.Ячейка всегда имеет формат 12345-6789, я пытаюсь заставить ее вернуть значение 12345. Однако ячейка заканчивается значением = Clean_Zip (cell.Value) вместо вставки формулы, ее запуска и извлечениявозвращаемое значение

Sub FixItUp()

Dim LastRow As Integer
Dim rng As Range, cell As Range


LastRow = ActiveSheet.Range("F" & ActiveSheet.Rows.Count).End(xlUp).Row

Set rng = ActiveSheet.Range("F5:F" & LastRow)

For Each cell In rng
    cell.Value = "=Clean_Zip(cell.Value)"
Next cell

End Sub




Public Function Clean_Zip(ZipCode)

'Function formats all zipcodes to a 5 digit number & converts text values to 
 number values

ZipCode = Trim(ZipCode)
Select Case countNumbers(ZipCode)

    Case Is <= 99
        Clean_Zip = "Error"
    Case Is <= 999
        Clean_Zip = "00" & countNumbers(ZipCode)
    Case Is <= 9999
        Clean_Zip = "0" & countNumbers(ZipCode)
    Case Is <= 999999
        Clean_Zip = Left(ZipCode, 5)
    Case Is <= 99999999
        Clean_Zip = "0" & Left(ZipCode, 4)
    Case Is <= 999999999
        Clean_Zip = Left(ZipCode, 5)

    Case countNumbers(ZipCode)
       Clean_Zip = countNumbers(ZipCode)

    If InStr(5, ZipCode, " ") Then
        Clean_Zip = Left(ZipCode, 5)
    End If

End Select
End Function




Public Function countNumbers(Cell)

If Left(Cell, 3) = 0 Then
        countNumbers = Mid(Cell, 4, 2)
    ElseIf Left(Cell, 2) = 0 Then
        countNumbers = Mid(Cell, 3, 3)
    ElseIf Left(Cell, 1) = 0 Then
        countNumbers = Mid(Cell, 2, 4)
    ElseIf IsNumeric(Left(Cell, 1)) And InStr(Left(Cell, 3), "-") Then
        countNumbers = "000" & Left(Cell, 2)
    ElseIf IsNumeric(Left(Cell, 1)) And InStr(Left(Cell, 4), "-") Then
        countNumbers = "00" & Left(Cell, 3)
    ElseIf IsNumeric(Left(Cell, 1)) And InStr(Left(Cell, 5), "-") Then
        countNumbers = "0" & Left(Cell, 4)
    ElseIf IsNumeric(Left(Cell, 1)) And InStr(Left(Cell, 6), "-") Then
        countNumbers = "0" & Left(Cell, 5)
    ElseIf IsNumeric(Left(Cell, 1)) Then
        countNumbers = Left(Cell, 10)
    Else
        countNumbers = Trim(Left(Cell, 3) & " " & Right(Cell, 3))
End If

End Function

Answer 1

В вашей подпрограмме FixItUp измените эту строку:

cell.Value = "=Clean_Zip(cell.Value)"

на эту:

Cell.Formula = "=Clean_Zip(""" & Cell.Value & """)"

В качестве альтернативы было бы неплохо обработать данные и перезаписать значение все водна простая подпрограмма вместо использования пользовательской функции ... вот пример:

Sub FixItUpV2()

    Dim LastRow As Integer
    Dim rng As Range, ZipCode As Range

    LastRow = ActiveSheet.Range("F" & ActiveSheet.Rows.Count).End(xlUp).Row

    Set rng = ActiveSheet.Range("F5:F" & LastRow)

    For Each ZipCode In rng
        'Change cell format to text:
        ZipCode.NumberFormat = "@"
        'Split original value on its hyphen, keep the first segment, and format with a 5 digit mask:
        ZipCode = Format(Split(Trim(ZipCode), "-")(0), "00000")
    Next ZipCode

End Sub

Answer 2

Может быть лучший подход с использованием TextToColumns.

Option Explicit

Sub FixItUp()

    With ActiveSheet
        With .Range(.Cells(5, "F"), .Cells(.Rows.Count, "F").End(xlUp))
            .TextToColumns Destination:=.Cells(1), DataType:=xlDelimited, _
                           TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
                           Tab:=False, Semicolon:=False, Comma:=False, Space:=False, _
                           Other:=True, OtherChar:="-", _
                           FieldInfo:=Array(Array(1, xlGeneralFormat), Array(2, xlSkipColumn))
            .NumberFormat = "00000"
            .FormatConditions.Delete
            With .FormatConditions.Add(Type:=xlExpression, Formula1:="=F5<=99")
                .NumberFormat = "\E\r\r\o\r"
                .Interior.Color = vbRed
            End With
        End With
    End With

End Sub

Искаженные почтовые индексы сохранят свои исходные значения при отображении ошибки на красном фоне.