VBA：根据条件搜索，保存和替换行 [英] VBA: Search, save and replace by rows according to conditions
问题描述
gen，N ,,, GONGD ,,, N ,,, KL， 0007bd ,,,,,,, TAK，
gen，N ,,, RATEC ,,, N ,,, KP，0007bc ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, ，EBFWE，N ,,,,,,,, KP，002bd4 ,,, KP，123000 ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, EBFWEI ,,, KP，002bd2，N ,,,,, KP，002bd3 ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 我有一个这样的代码：
Sub Find（）
Dim rFoundAddress As Range
Dim sFirstAddress As String
Dim x As Long
With ThisWorkbook.Worksheets（Sheet1）。列（1）
设置rFoundAddress = .Find（kap，*，LookIn：= xlValues，LookAt：= xlWhole）
如果没有rFoundAddress不是然后
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_stri ng，KP）
i = Left（WrdArray（1），6）
k = Left（WrdArray（2），6）
列（A）。替换为：= i，_
替换：= k，_
LookAt：= xlPart，_
SearchOrder：= xlByRows，_
MatchCase：= False，_
SearchFormat：= False，_
ReplaceFormat：= False
设置rFoundAddress = .FindNext（rFoundAddress）
循环，而不是rFoundAddress不是和_
rFoundAddress.Address <> sFirstAddress
如果
结束
End Sub
我试图做：
找到所有以kap开始的行，并在第一个KP之后保存6个chars / int，第二个KP作为i和6个chars / int，为k。然后搜索整个数据集（列A中的数百行），如果它们包含字符串i，如果是，则将其替换为字符串k。并循环这个。所以它将以kap开头的另一行做同样的事情。该代码给我错误信息：下标超出范围，当涉及到列（A）...第二次。你可以帮助我吗？
谢谢你的提前
编辑使所有搜索的字符串出现相同（kap，*）
您不想修改（通过 Replace（））你正在循环的范围
所以在循环遍历范围时收集所有需要的替换，然后循环通过数组，并进行替换
，如下所示：
Option Explicit
Sub Find（）
Dim rFound As Range
Dim sFirstAddress As String
Dim val As Variant
Dim nKap As Long
使用ThisWorkbook.Worksheets（Sheet1）。列（1）
nKap = Application.WorksheetFunction.CountIf（.Cells，kap，*）'< - |计数kap，*的出现
如果nKap> 0然后
ReDim vals（1 to nKap）As Variant'< - |将收集所有查找/替换对象的数组
nKap = 0
设置rFound = .Find（kap，*，LookIn：= xlValues，LookAt：= xlWhole）
sFirstAddress = rFound。地址
Do
nKap = nKap + 1
vals（nKap）= Split（Split（Split（rFound.text，KP）（1），，）（1）& ;&Split（Split（rFound.text，KP）（2），，）（1），，）'<存储第i个几个find / replace值
设置rFound = .FindNext（rFound）
循环while rFound.Address<> sFirstAddress
对于每个val在vals'< - |循环通过值替换数组
.Replace什么：= val（0），_
替换：= val（1），_
LookAt：= xlPart，_
SearchOrder ：= xlByRows，_
MatchCase：= False，_
SearchFormat：= False，_
ReplaceFormat：= False
下一个val
如果
End with
End Sub
函数GetValues（txt As String）As Variant
如果InStr（txt，KP）> 0然后GetValues = Split（Split（txt，KP）（1），，）（1）&，& Split（Split（txt，KP）（2） ）（1），，）
结束函数
I have an input like this:
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
I have a code like this:
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
What I am trying to do: Find all lines starting with "kap" and save 6 chars/int after first "KP" as i and 6 chars/int after second "KP" as k. Then search the whole data-set (hundreds of rows in column A) if they contain string i and if yes, then replace it for string k. And to loop this. So it will do the same with another line starting with "kap". The code gives me error message: Subscript out of range when it comes to "Columns("A")..." for the second time. Can you help me please?
THANK YOU IN ADVANCE
edited to make all searched string occurrences the same ("kap,*")
you don't want to modify (via Replace()) the range you're looping through
so collect all needed replacements in an array while looping through the range and then loop through the array and make the replacements
like follows:
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：根据条件搜索，保存和替换行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
