VBA: Search, save and replace by rows according to conditions -
i have input 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 code this:
sub find() dim rfoundaddress range dim sfirstaddress string dim x long thisworkbook.worksheets("sheet1").columns(1) set rfoundaddress = .find("kap,*", lookin:=xlvalues, lookat:=xlwhole) if not rfoundaddress nothing sfirstaddress = rfoundaddress.address dim wrdarray() string dim text_string string dim string dim k string dim num long text_string = rfoundaddress wrdarray() = split(text_string, "kp,") = 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 nothing , _ rfoundaddress.address <> sfirstaddress end if end end sub
what trying do: find lines starting "kap" , save 6 chars/int after first "kp" , 6 chars/int after second "kp" k. search whole data-set (hundreds of rows in column a) if contain string , if yes, replace string k. , loop this. same line starting "kap". code gives me error message: subscript out of range when comes "columns("a")..." second time. can me please?
thank in advance
edited make searched string occurrences same ("kap,*")
you don't want modify (via replace()
) range you're looping through
so collect needed replacements in array while looping through range , loop through array , make replacements
like follows:
option explicit sub find() dim rfound range dim sfirstaddress string dim val variant dim nkap long thisworkbook.worksheets("sheet1").columns(1) nkap = application.worksheetfunction.countif(.cells, "kap,*") '<--| count occurrences of "kap,*" if nkap > 0 redim vals(1 nkap) variant '<--| array collect find/replace couples nkap = 0 set rfound = .find("kap,*", lookin:=xlvalues, lookat:=xlwhole) sfirstaddress = rfound.address nkap = nkap + 1 vals(nkap) = split(split(split(rfound.text, "kp")(1), ",")(1) & "," & split(split(rfound.text, "kp")(2), ",")(1), ",") '<--| store ith couple of find/replace values set rfound = .findnext(rfound) loop while rfound.address <> sfirstaddress each val in vals '<--| loop through values replaced array .replace what:=val(0), _ replacement:=val(1), _ lookat:=xlpart, _ searchorder:=xlbyrows, _ matchcase:=false, _ searchformat:=false, _ replaceformat:=false next val end if end end sub function getvalues(txt string) variant if instr(txt, "kp") > 0 getvalues = split(split(split(txt, "kp")(1), ",")(1) & "," & split(split(txt, "kp")(2), ",")(1), ",") end function
Comments
Post a Comment