查找string和偏移数据VBA

我在这里停滞不前。 我想要做的是search列A的数字开头的单元格。 然后从那个位置看上面的单元格,直到find一个以“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 

以下是前后的内容:

之前

后

尝试这个:

 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