vba 記述をスマートにしたい
お世話になります。
以下の記述をもっと簡略化させたいのですが、
列とシートが違うだけで、同じ処理を２回しているだけなので、
出来そうで、自分では出来ませんでした。
どなたかご教示頂きたく宜しくお願い致します。
記
Set myrngv = Workbooks("Ａ.xls").Sheets("sheet1").Range("a:a")
Set myrngYK = Workbooks("Ａ.xls").Sheets("sheet1").Range("t:t")
Set myrialz = Workbooks("Ａ.xls").Sheets("sheet2").Range("b:b")
Set myXBrialz = Workbooks("Ａ.xls").Sheets("sheet3").Range("b:b")
j = 3
Do
j = j + 1
myhin = myrngv.Cells(j, 1).Value
If myhin = "" Then Exit Do
Set c = myrialz.Find(what:=myhin, Lookat:=xlWhole)
If Not c Is Nothing Then
firstaddress = c.Address
Do
myrow = c.Row
myrngv.Cells(j, 9) = myrialz.Cells(myrow, 7).Value
myrngv.Cells(j, 11) = myrialz.Cells(myrow, 8).Value
myrngv.Cells(j, 13) = myrialz.Cells(myrow, 3).Value
myrngv.Cells(j, 5) = myrialz.Cells(myrow, 3).Value + Cells(myrow, 7).Value - Cells(myrow, 8).Value
Set c = myrialz.FindNext(c)
Loop Until firstaddress = c.Address
End If
Loop
'ここより下が同じ様な処理
j = 3
Do
j = j + 1
myhin = myrngYK.Cells(j, 1).Value
If myhin = "" Then Exit Do
Set c = myXBrialz.Find(what:=myhin, Lookat:=xlWhole)
If Not c Is Nothing Then
firstaddress = c.Address
Do
myrow = c.Row
myrngYK.Cells(j, 8) = myXBrialz.Cells(myrow, 7).Value
myrngYK.Cells(j, 10) = myXBrialz.Cells(myrow, 8).Value
myrngYK.Cells(j, 12) = myXBrialz.Cells(myrow, 3).Value
myrngYK.Cells(j, 6) = myXBrialz.Cells(myrow, 3).Value + Cells(myrow, 7).Value - Cells(myrow, 8).Value
Set c = myXBrialz.FindNext(c)
Loop Until firstaddress = c.Address
End If
Loop
お礼
いつもありがとうございます。 解決しました。