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

Question

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

请看图片。如果我不太清楚，我很抱歉。

             之前：                         之后：
  

现在我有以下代码：

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

试试这个简短的子程序。

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 2

试试下面的代码

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 3

此代码应处理有超过 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 4

替代：

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 5

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

1. 首先我们需要一个虚拟列来填充空白行。在 B2 上使用以下公式并将其复制到 A 列的最后一行：

   =IF(A2<>"",A2,B1)
   

2. 然后我们将在 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 值连接起来。

当一切正常时，你应该有类似下面的东西：