Question

我有一个excelsheet专栏＆＃39; Ranges＆＃39;其中我有随机顺序的多行文字。我需要在多行文本中找到特定的前缀并将其粘贴到下一列。

目标是按DS＆gt; FP＆gt; NP＆gt; 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 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

Answer 2

您可以使用我在您提供的测试用例上测试的以下代码及其正常工作。

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

如果没有选择的话，编辑代码写第一行。

Excel宏多行查找条件和插入

2 个答案: