Question

我有这样的输入：

gen,N,,,GONGD,,,N,,,KL,0007bd,,,,,,,,TAK,
gen,N,,,RATEC,,,N,,,KP,0007bc,,,,,,,,TAZ,
kap,N,,,EBFWE,N,,,,,,,,,KP,002bd4,,,KP,123000,,,,,N,,,,P
kap,N,,,ST,WEIT,E3,EBFWEI,,,KP,002bd2,N,,,,,,KP,002bd3,,,,,,,Z,MG00,,,,,N,,,,P

我有这样的代码：

Sub Find()
Dim rFoundAddress As Range
Dim sFirstAddress As String
Dim x As Long

With ThisWorkbook.Worksheets("Sheet1").Columns(1)
    Set rFoundAddress = .Find("kap,*", LookIn:=xlValues, LookAt:=xlWhole)
    If Not rFoundAddress Is Nothing Then
        sFirstAddress = rFoundAddress.Address
        Do
            Dim WrdArray() As String
            Dim text_string As String
            Dim i As String
            Dim k As String
            Dim num As Long
            text_string = rFoundAddress
            WrdArray() = Split(text_string, "KP,")
            i = Left(WrdArray(1), 6)
            k = Left(WrdArray(2), 6)

            Columns("A").Replace What:=i, _
                        Replacement:=k, _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByRows, _
                        MatchCase:=False, _
                        SearchFormat:=False, _
                        ReplaceFormat:=False

            Set rFoundAddress = .FindNext(rFoundAddress)
        Loop While Not rFoundAddress Is Nothing And _
            rFoundAddress.Address <> sFirstAddress
    End If
End With
End Sub

我想做什么：找到所有以＆＃34; kap＆＃34;开头的行并且在第一次＆＃34; KP＆＃34;之后保存6个字符/ int;作为i和6个字符/ int在第二个＆＃34; KP＆＃34;作为k。然后搜索整个数据集（列A中的数百行），如果它们包含字符串i，如果是，则将其替换为字符串k。并循环这个。因此，对于以＆＃34; kap＆＃34;开头的另一行，它也会这样做。代码给了我错误信息：当涉及到＆＃34;列时，下标超出范围（＆＃34; A＆＃34;）......＆＃34;第二次。你能帮帮我吗？

先谢谢你

Answer 1

已修改以使所有搜索的字符串出现次数相同（“kap，*”）

您不想修改（通过Replace()）您正在循环的范围

所以在循环遍历范围时收集数组中所有需要的替换，然后循环遍历数组并进行替换

如下：

Option Explicit

Sub Find()
    Dim rFound As Range
    Dim sFirstAddress As String
    Dim val As Variant
    Dim nKap As Long

    With ThisWorkbook.Worksheets("Sheet1").Columns(1)
        nKap = Application.WorksheetFunction.CountIf(.Cells, "kap,*") '<--| count the occurrences of "kap,*"
        If nKap > 0 Then
            ReDim vals(1 To nKap) As Variant '<--| array that will collect all find/replace couples
            nKap = 0
            Set rFound = .Find("kap,*", LookIn:=xlValues, LookAt:=xlWhole)
            sFirstAddress = rFound.Address
            Do
                nKap = nKap + 1
                vals(nKap) = Split(Split(Split(rFound.text, "KP")(1), ",")(1) & "," & Split(Split(rFound.text, "KP")(2), ",")(1), ",") '<--| store the ith couple of find/replace values
                Set rFound = .FindNext(rFound)
            Loop While rFound.Address <> sFirstAddress

            For Each val In vals '<--| loop through values to be replaced array
                .Replace What:=val(0), _
                        Replacement:=val(1), _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByRows, _
                        MatchCase:=False, _
                        SearchFormat:=False, _
                        ReplaceFormat:=False
             Next val
        End If


    End With
End Sub

Function GetValues(txt As String) As Variant
    If InStr(txt, "KP") > 0 Then GetValues = Split(Split(Split(txt, "KP")(1), ",")(1) & "," & Split(Split(txt, "KP")(2), ",")(1), ",")
End Function

VBA：根据条件

1 个答案: