以月份为单位修剪字符，只显示前三个字符

Question

我已经编写了一个循环，它在包含月份名称的范围内运行，并修剪任何超过三个字符的字符，因为我只需要看到前三个字符，即：Jan而不是Jan。

下面的代码用于识别包含较长名称的单元格，但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

Answer 1

此代码将公式添加到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