Добавить строку, если длина существующей строки равна 4

Question

Мне нужен сценарий VBA, который читает столбец строк. В этом столбце будут такие строки, как: ['239222', '292291', '939328', '2343', '923219', '3928']. Однако я хочу добавлять четыре ведущих нуля каждый раз, когда строка имеет длина равна 4.

Я бы получил: ['239222', '292291', '939328', '00002343', '923219', '00003928']

это возможно?

Answer 1

Вставить префикс

• Отрегулируйте четыре const муравьев в соответствии с вашими требованиями.

• Код написан для ActiveSheet. Попробуйте изменить его, уточнив рабочий лист.

Код

Option Explicit

Sub insertPrefix()

    Const FirstRow As Long = 2        ' Column Range First Row
    Const ColumnID As Variant = "A"   ' Column Number or Letter e.g. 1 or "A"
    Const TextLength As Long = 4
    Const TextPrefix As String = "0000"

    Dim rng As Range              ' Last Non-Empty Cell, Column Range
    Dim cel As Range              ' Current Cell (For Each Control Variable)

    ' Task: Define Column Range.

    ' Define Last Non-Empty Cell
    Set rng = Columns(ColumnID).Find(What:="*", LookIn:=xlFormulas, _
                                     SearchDirection:=xlPrevious)
    ' Check if all cells in column are empty.
    If rng Is Nothing Then Exit Sub
    ' Check if cell in FirstRow and cells below are empty.
    If rng.Row < FirstRow Then Exit Sub
    ' Define Column Range.
    Set rng = Range(Cells(FirstRow, ColumnID), rng)

    ' Change NumberFormat of Column Range to Text (@).
    rng.NumberFormat = "@"

    ' Task: Modify cells of Column Range

    ' Loop through cells of Column Range.
    For Each cel In rng
        ' Check if length of the value in Current Cell is equal to TextLength.
        If Len(cel.Value) = TextLength Then
            ' Insert TextPrefix in front of value in current cell.
            cel.Value = TextPrefix & cel.Value
        End If
    Next cel

End Sub