Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

75229 / 76738

←次へ　｜　前へ→


	【5951】Re:分割→コピー

ichinose - 03/6/11(水) 6:36 -


	引用なし

	パスワード

▼jun さん：
おはようございます。
Match関数使うと、ちょっとだけスッキリしたので
別解です。

'==========================================================
Sub main3()
　　Dim s1rng As Range
　　Dim s2rng As Range
　　Dim s1crng As Range
　　Application.ScreenUpdating = False
　　With Worksheets("sheet1")
　　　Set s1rng = .Range("a1", .Cells(.Rows.Count, 1).End(xlUp))
　　　End With
　　With Worksheets("sheet2")
　　　Set s2rng = .Range("a1", .Cells(.Rows.Count, 1).End(xlUp))
　　　For Each s1crng In s1rng
　　　　With s2rng.Offset(0, 1)
　　　　　Worksheets("sheet2").Range(.Cells(Mymatch(s1crng, s2rng)), .Cells(Mymatch(s1crng.Offset(0, 1), s2rng))).Value = s1crng.Offset(0, 4).Value
　　　　　End With
　　　　Next
　　　End With
　　Application.ScreenUpdating = True
End Sub
'=========================================================
Function Mymatch(rng1 As Range, rng2 As Range) As Long
　　On Error Resume Next
　　Mymatch = WorksheetFunction.Match(rng1, rng2, 1)
　　On Error GoTo 0
End Function

5 hits

▼

【5946】分割→コピー jun 03/6/10(火) 16:36