Как добавить пробелы в каждый столбец в диапазоне, где количество символов в каждом столбце равно 20?

Question

Я использую программу, которая принимает данные только по 20 символов в каждой ячейке.Каждый столбец имеет одинаковое количество символов в ячейке, но они варьируются от одного до восьми.В любом случае, нужно ли вводить пробелы в каждой ячейке, чтобы они добавляли до 20 символов?

Dim wb1 As Workbook
Dim ws1 As Worksheet
Dim rang As range
Dim colA As range

Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("osbstd")
Set rng = ws1.range("A1:FJ10000")
Set colA = ws1.range("A1:A10000")

For Each one In Selection
   If colA.Value <> "" Then colA.Value = colA.Value & Space(19)
Next

В поисках более простого способа сделать это вместо затемнения каждого столбца (поскольку имеется 23 столбца) и выполнения оператора if для каждого столбца

Answer 1

Для меня самый простой способ сделать это так:

Dim result As String
For j = 1 To 23
    For i = 1 To 10000
        result = Cells(i, j).Value
        Do While Len(result) < 20
            result = result & " "
        Loop
        Cells(i, j).Value = result
    Next i
Next j

Answer 2

Попробуйте:

Sub tgr()

    'Change this to be the columns you need to adjust
    Const sColumns As String = "A:D,F:F"

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rArea As Range
    Dim rData As Range
    Dim rLast As Range
    Dim aData() As Variant
    Dim i As Long, j As Long

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("osbstd")

    For Each rArea In ws.Range(sColumns).Areas
        Set rLast = rArea.Find("*", rArea.Cells(1), xlValues, , , xlPrevious)
        If Not rLast Is Nothing Then
            With rArea.Resize(rLast.Row)
                If .Cells.Count = 1 Then
                    ReDim aData(1 To 1, 1 To 1)
                    aData(1, 1) = .Value
                Else
                    aData = .Value
                End If
                For i = 1 To UBound(aData, 1)
                    For j = 1 To UBound(aData, 2)
                        If Len(aData(i, j)) > 0 Then aData(i, j) = Left(aData(i, j) & Space(20), 20)
                    Next j
                Next i
                .Value = aData
                Erase aData
            End With
        End If
    Next rArea

End Sub