在文本末尾添加一个字符并将字母 A 递增到 B

Question

我需要帮助的是将前面的单元格文本复制到它下面的单元格中并在末尾添加字母A它 即在 VP0007 之前 VP0007A 之后。这应该一直持续到所有空白单元格都递增并到达下一个 VP0008.

请看图片。如果我不太清楚，请见谅。

之前： 之后：[=281=][

现在我有以下代码：

ActiveCell.Offset(1, 0).Select Letter = "A" Letters = Chr(Asc(Letter) + 1) Number = ActiveCell.Offset(-1, 0).Value If ActiveCell.Value = Number & Letter _ Then ActiveCell.Offset(1, 0).Select.Value Number & Number Else ActiveCell.Value = Number & Letters End If Loop Until ActiveCell.Offset(1, 0).Value <> ""

Answer 1

尝试使用下面的代码

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Letter = "A"
For iLoop = 2 To LastRow
    If ActiveSheet.Range("A" & iLoop) = "" Then
        iValue = ActiveSheet.Range("A" & iLoop - 1)
        iiLoop = iLoop
        Do
            If ActiveSheet.Range("A" & iiLoop) = "" Then
                ActiveSheet.Range("A" & iiLoop) = iValue & Letter
                Letter = Chr(Asc(Letter) + 1)
            Else
                Letter = "A"
                Exit Do
            End If
            iiLoop = iiLoop + 1
        Loop
        iLoop = iiLoop - 1
    End If
Next

Answer 2

试试这个简短的子程序。

Sub fillSubseries()
    Dim i As Long, a As Long, str As String

    With Worksheets("sheet4")
        For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            If IsEmpty(.Cells(i, "A")) Then
                .Cells(i, "A") = str & Chr(a)
                a = a + 1
            Else
                a = 65
                str = .Cells(i, "A").Value2
            End If
        Next i
    End With
End Sub

Answer 3

备用：

Sub tgr()

    Dim ws As Worksheet
    Dim aData As Variant
    Dim sTemp As String
    Dim sLetter As String
    Dim i As Long, j As Long

    Set ws = ActiveWorkbook.ActiveSheet
    With ws.Range("A2", ws.Cells(ws.Rows.Count, "A").End(xlUp))
        If .Row < 2 Then Exit Sub   'No data
        aData = .Value
    End With

    For i = LBound(aData, 1) To UBound(aData, 1)
        If Len(Trim(aData(i, 1))) > 0 Then
            sTemp = Trim(aData(i, 1))
            j = 0
        Else
            j = j + 1
            sLetter = Replace(ws.Cells(1, j).Address(0, 0), 1, vbNullString)
            aData(i, 1) = sTemp & sLetter
        End If
    Next i

    ws.Range("A2").Resize(UBound(aData, 1)).Value = aData

End Sub

Answer 4

此代码应处理超过 26 个空白行并递增超过字母 "Z" 的情况。

Sub FillBlanks()

Dim lastRow As Long, cnt As Long, i As Long
Dim prevItem As String
Dim ws As Worksheet

Set ws = ActiveSheet

lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
prevItem = ws.Cells(2, 1).Value
cnt = 0

For i = 2 To lastRow

  If ws.Cells(i, 1) = "" Then
    cnt = cnt + 1
    ws.Cells(i, 1).Value = prevItem & Split(Cells(1, cnt).Address(True, False), "$")(0)
  Else
    prevItem = ws.Cells(i, 1)
    cnt = 0
  End If

Next i

End Sub

Answer 5

如果您需要纯公式解决方案，您可以尝试以下步骤（数据的第一行应该是 A2，而不是 A1）：

首先我们需要一个虚拟列来填充空白行。在 B2 上使用以下公式并将其复制到 A 列的最后一行：
```
=IF(A2<>"",A2,B1)
```
然后我们将在 C 列上创建最终值。将以下公式添加到 C2 并向下复制：
```
=IF(A2<>"",A2,IF(ISNUMBER(VALUE(RIGHT(C1,1)))=TRUE,C1&"A",B2&CHAR(CODE(RIGHT(C1,1))+1)))
```

基本上我们首先用B列的重复值填充空白行。如果Col:A不为空，则将Col:A值复制到Col:C。如果 Col:A 为空白且上行 (Col:C) 值的最后一个字符是数字，我们将 "A" 添加到该值。如果最后一个字符是一个字母，那么我们将下一个字母与 Col:B 值连接起来。

如果一切正常，您应该会看到如下内容：

在文本末尾添加一个字符并将字母 A 递增到 B

Adding a character at the end of text & increment letter A to B

excel

vba

loops

increment