Question

我需要帮助的是将之前的单元格文本复制到其下方的单元格中并在其末尾添加字母A VP0007之后的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

替代：

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：C，如果Col：A不是空白。如果Col：A是空白而上排（Col：C）值的最后一个字符是数字，我们添加＆＃34; A＆＃34;达到那个价值。如果最后一个字符是一个字母，那么我们将下一个字母与Col：B值连接起来。

当一切正常时，您应该拥有以下内容：

在文字末尾添加一个字符＆amp;将字母A增加到B

5 个答案: