查找字符串数组中的字符串索引

时间:2016-07-01 16:05:35

标签: arrays string excel vba excel-vba

enter image description here enter image description here enter image description here

此程序将数组中的字符串删除到新工作表。我发现字符串'你好'或者' bye'但我也想在每个字符串之前的索引中的字符串。在'你好之前的字符串'或者' bye'并不总是一样的,所以我如何使用Index()函数?



Sub SplitWithFormat()
    Dim R As Range, C As Range
    Dim i As Long, V As Variant
    Dim varHorizArray As Variant
    Dim rge As Range
    Dim intCol As Integer
   
Set R = Range("d1", Cells(Rows.Count, "d").End(xlUp))
For Each C In R
    With C
        .TextToColumns Destination:=.Range("AD1"), DataType:=xlDelimited, _
        consecutivedelimiter:=True, Tab:=False, semicolon:=True, comma:=False, _
        Space:=True, other:=True, Otherchar:=vbLf

        Set rge = Selection
        varHorizArray = rge
        .Copy
        Range(.Range("AD1"), Cells(.Row, Columns.Count).End(xlToLeft)).PasteSpecial xlPasteFormats
    End With
Next C

Application.CutCopyMode = False

    For intCol = LBound(varHorizArray, 2) To UBound(varHorizArray, 2)
       Debug.Print varHorizArray(1, intCol)
    Next intCol
    
       
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    varHorizArray = Array("bye","hello")
    Set NewSh = Worksheets.Add

    With Sheets("Sheet2").Range("AD1:AZ100")

        Rcount = 0

        For i = LBound(varHorizArray) To UBound(varHorizArray)

            
            Set Rng = .find(What:=varHorizArray(i), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                FirstAddress = Rng.Address
                Do
                    Rcount = Rcount + 1

                    Rng.Copy NewSh.Range("A" & Rcount)

                    
                    NewSh.Range("A" & Rcount).Value = Rng.Value

                    Set Rng = .FindNext(Rng)
                Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
            End If
        Next i
    End With

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub
&#13;
&#13;
&#13;

1 个答案:

答案 0 :(得分:2)

虽然InStr function通常用于查找字符串中的子字符串,但使用Split function可以更好地处理多个搜索字词。

Option Explicit

Sub stripName()
    Dim rw As Long

    With ActiveSheet
        For rw = 1 To .Cells(Rows.Count, "D").End(xlUp).Row
            .Cells(rw, "A") = Split(Split(.Cells(rw, "D").Value2, ", hello")(0), ", bye")(0)
        Next rw
    End With

End Sub

请注意,拆分中使用的搜索字词区分大小写。

split_names

修订问题的附录:

Option Explicit

Sub stripName()
    Dim rw As Long, s As String

    With ActiveSheet
        For rw = 1 To .Cells(Rows.Count, "D").End(xlUp).Row
            s = Split(.Cells(rw, "D").Value2, ", bye")(0)
            s = Split(s, ", hello")(0)
            s = Split(Chr(32) & s, Chr(32))(UBound(Split(Chr(32) & s, Chr(32))))
            .Cells(rw, "A") = s
        Next rw
    End With

End Sub

split_names2