查找字符串和偏移数据VBA

Question

我在这里停滞不前。我要做的是在列A中搜索以数字开头的单元格。然后从该位置查看其上方的单元格，直到找到以“L”开头的单元格。最后，将以数字开头的单元格移动到“L”单元格右侧的下一个空白单元格。然后重复，直到没有更多的单元格以A列中的数字开头。这是我到目前为止所拥有的：

Sub Code_Relocate()

Dim ws1         As Worksheet
Dim codecheck   As Boolean
Dim lastrow     As Long
Dim i           As Long

Set ws1 = ThisWorkbook.Sheets("Sheet1")
lastrow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row

For i = 1 To lastrow

codecheck = Range("A" & i).Value Like "[0-9]*"

    If codecheck = True Then
        'Search from this point up, find first cell that begins with "L" and move code to the next blank cell on the right
    End If

Next i

End Sub

以下是之前和之后的情况：

Answer 1

试试这个：

Sub Code_Relocate()

Dim ws1         As Worksheet
Dim temp        As String
Dim lastrow     As Long
Dim i           As Long
Dim tempArr()   As String
Dim j           As Long


Set ws1 = ThisWorkbook.Sheets("Sheet1")
lastrow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row

For i = lastrow To 1 Step -1
    If IsNumeric(ws1.Range("A" & i)) And Len(ws1.Range("A" & i)) > 0 Then
        temp = ws1.Range("A" & i) & " " & temp
        ws1.Range("A" & i).ClearContents
    ElseIf Left(ws1.Range("A" & i), 1) = "L" Then
        tempArr = Split(Trim(temp))
        For j = LBound(tempArr) To UBound(tempArr)
            If tempArr(j) <> "" Then
                ws1.Cells(i, 2 + j) = --tempArr(j)
            End If
        Next j

        temp = ""
        Erase tempArr
    End If

Next i

End Sub