Обрезать символы по месяцам, чтобы показать только первые три символа - PullRequest
0 голосов
/ 11 декабря 2018

Я написал цикл, который проходит через диапазон, содержащий названия месяцев, и обрезает любые, которые больше трех символов, так как мне нужно видеть только первые три, т. Е .: Ян вместо января.

Приведенный ниже код работает для идентификации ячеек, содержащих более длинные имена, но функция LEFT очищает ячейку, а не просто удаляет лишние символы, чтобы показать только первые три.Есть идеи, что не так в функции?Помощь очень ценится.

Большое спасибо.

Sub TrimMonth()
    Application.ScreenUpdating = "False"

    Dim rng As Range
    Dim i, counter As Integer
    Dim lastrow As Long

    lastrow = ActiveSheet.Range("A1048576").End(xlUp).row

    'Set the range to evaluate.
    Set rng = Range("A2:A" & lastrow)

    'initialize i to 1
    i = 1

    'Loop for a count of 1 to the number of rows in
    'the range to evaluate.
    For counter = 1 To rng.Rows.Count
        'If cell i in the range contains more than 3
        'characters then trim to 3 characters else increment i
        If Len(rng.Cells(i)) > 3 Then
            rng.Cells(i).Value = Left(Cells(i).Value, 3)
            i = i + 1
        Else
            i = i + 1
        End If
    Next

    Application.ScreenUpdating = "True"   
End Sub

1 Ответ

0 голосов
/ 11 декабря 2018

Этот код добавляет формулу в столбец B, чтобы вернуть трехбуквенный текст месяца, а затем копирует значения в столбец A перед удалением формулы.

Sub TrimMonth()

    Dim rDates As Range

    With ThisWorkbook.Worksheets("Sheet1")

        'Set reference to range containing month names.
        Set rDates = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))

        'Add formula one column to right.
        'This will convert the month name to a real date and then format it
        'as three letter month text.
        rDates.Offset(, 1).FormulaR1C1 = _
            "=TEXT(DATEVALUE(""1-"" & RC[-1]),""mmm"")"

        'Replace originals with values from formula.
        rDates.Value = rDates.Offset(, 1).Value

        'Clear formula.
        rDates.Offset(, 1).ClearContents

    End With

End Sub  

Или сделать это без добавления формулы:

Sub TrimMonth()

    Dim rDates As Range
    Dim rCell As Range

    With ThisWorkbook.Worksheets("Sheet1")

        'Set reference to range containing month names.
        Set rDates = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))

        'Convert each cell in range.
        For Each rCell In rDates
            rCell.Value = Format(CDate("1-" & rCell), "mmm")
        Next rCell

    End With

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...