Excel宏多行查找條件並插入

Question

我有一個excelsheet列'範圍'，其中我有隨機順序的多行文本。我需要在多行文本中找到特定的前綴並將其粘貼到下一列。

目標是按照DS> FP> NP> HE等順序查找前綴，其中如果DS前綴不存在FP等等。

試片的結果看起來如下： -

我有下面的代碼到現在爲止，請幫我解決這個任務： -

Sub Rangess() 

    Dim colNum As Integer 
    colNum = ActiveSheet.rows(1).Find(What:="Range", LookAt:=xlWhole).Column 
    ActiveSheet.Columns(colNum + 1).Insert 
    ActiveSheet.Cells(1, colNum + 1).Value = "NEW" 

End Sub 

Answer 1

你可以使用我已經測試過的下面的代碼您提供的測試用例及其工作正常。

Sub Test() 
    Dim colNum As Integer 
    colNum = ActiveSheet.Rows(1).Find(What:="Range", LookAt:=xlWhole).Column 
    ActiveSheet.Columns(colNum + 1).Insert 
    ActiveSheet.Cells(1, colNum + 1).Value = "NEW" 

    'counting no of rows 
    Dim No_Of_Rows As Long 
    No_Of_Rows = ActiveSheet.UsedRange.Rows.Count 

    Dim Range_col_val As Variant 
    Dim split_Range_col As Variant 
    Dim Range_splited_cell_val As Variant 
    Dim Prefix As Variant 
     Prefix = Array("DS", "FP", "NP", "HE") 
    Dim FLAG As Boolean 
    Dim j As Integer 



    'Looping for rows 

    For i = 2 To No_Of_Rows 

     'Extracting Data from col Range 

     Range_col_val = Cells(i, colNum).Value 
     split_Range_col = Split(Range_col_val, vbLf) 
     j = 0 
     ActiveSheet.Cells(i, colNum + 1).Value = split_Range_col(0) 
     FLAG = False 
     While FLAG = False And j < 5 
      'Looping for Each Line in Col Range 
      For k = LBound(split_Range_col) To UBound(split_Range_col) 
       Range_splited_cell_val = split_Range_col(k) 
       If (Range_splited_cell_val Like Prefix(j) & "*") Then 
        ActiveSheet.Cells(i, colNum + 1).Value = Range_splited_cell_val 
        FLAG = True 
       End If 
      Next k 
      j = j + 1 
     Wend 
    Next i 
End Sub 

編輯代碼以寫入第一行，如果沒有選擇工作。

Answer 2

嘗試：

Sub test() 

Dim colNum As Long 
    colNum = ActiveSheet.Rows(1).Find(What:="Range", LookAt:=xlWhole).Column 
    ActiveSheet.Columns(colNum + 1).Insert 
    ActiveSheet.Cells(1, colNum + 1).Value = "NEW"   


Dim Arr As Variant 
Dim Lr As Long, R As Long 
Dim i As Long, n As Long 
Dim V As String, F As String 

Lr = Cells(Rows.Count, colNum).End(xlUp).Row  
Arr = Array("DS", "FP", "NP", "HE") 

For R = 2 To Lr 
    V = Cells(R, colNum).Value 
    For i = 0 To UBound(Arr) 
    n = InStr(V, Arr(i)) 
    If n <> 0 Then 
     F = Mid(V, n) 
     If InStr(F, vbLf) <> 0 Then F = Split(F, vbLf)(0) 
     Cells(R, colNum + 1).Value = F 
     Exit For 
    End If 
    Next 
Next 

End Sub