Question

我想开发一种自动化。

从A2开始将A2的内容移动到B3和B4然后将内容A5移动到B6到B8，然后将A9移动到B10，依此类推到最后

的记录

逻辑是，如果单元格AX具有以“Acc”开头的字符串，则将内容移动到单元格BX + 1中如果下一单元格AX + 2未以“Acc”开头

然后复制上面的单元格BX，依此类推，直到数据结束。

当单元格AX为空时停止。这是我试过的代码，但它不起作用

Private Sub CommandButton1_Click()

 Dim recSheet As Worksheet
 Set recSheet = ThisWorkbook.Sheets("original")

loop through column A and find words
'which starts with "Acc" if next cell is not starting with "Acc"

LastRow = recSheet.Cells(Rows.Count, "A").End(xlUp).Row
NextRow = recSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1

 For i = 2 To LastRow

   If Range("A" & i).Value = "Acc*" And NextRow <> "Acc*" Then
    Range("A" & i).Select
    Selection.Cut

     Range("B" & i").Select
    ActiveSheet.Paste

   End If
Next i
End Sub

Answer 1

尝试使用以下代码

Private Sub CommandButton1_Click()
    Dim texttocopy as String
    Dim lastrow As Long
    Dim i As Long
    Dim recSheet As Worksheet
    Set recSheet = ThisWorkbook.Sheets("original")
    lastrow = recSheet.Cells(Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastrow
        texttocopy = Range("A" & i).Value
        If Range("A" & i).Value Like "Acc*" And Not Range("A" & i + 1).Value Like "Acc*" Then
            i = i + 1
            Do While Not Range("A" & i).Value Like "Acc*" And Range("A" & i).Value <> ""
'                Range("A" & i).Select
'                Selection.Cut
'                Range("B" & i).Select
'                ActiveSheet.Paste
                Range("B" & i).Value = texttocopy
                If i >= lastrow Then
                    Exit For
                Else
                    i = i + 1
                End If
            Loop
            i = i - 1
        End If
    Next i
End Sub

Excel从A列到B的复制单词以“Acc”开头

1 个答案: