| |
▼kiki さん：
> >抽出リストは 別の専用シートに置くという案
と
やはり最初に提案した 【フィルタオプション】案で
再度書いてみました。
前のフィルタオプション は抽出したものを別の範囲に一気に
書き出すオプションでしたが、抽出先が結合セルであるため、
こんどは抽出元シート上で抽出して、抽出行を一行づつ転記
するというものです。
Sub マッチング3()
Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet
Dim Rng1 As Range
Dim Rng2 As Range
Dim Rng3 As Range
Dim c As Range, c1 As Range, c2 As Range
Set WS1 = Worksheets("Sheet1")
Set WS2 = Worksheets("抽出")
Set WS3 = Worksheets("抽出リスト")
With WS1 '抽出元表検索範囲は A列 [A1]は列見出し
Set Rng1 = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
End With
With WS2 '転記先セル（2か所）
Set c1 = .Range("C5")
Set c2 = .Range("O5")
End With
With WS3 '抽出リスト範囲
Set Rng3 = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
Rng3.Item(1).Formula = "=" & Rng1.Item(1).Address(External:=True)
End With
'フィルタオプション実行 (抽出リスト範囲 Rng3)
Rng1.AdvancedFilter xlFilterInPlace, Rng3
'Rng1の可視セルだけ転記処理
For Each c In Intersect(Rng1, Rng1.Offset(1)) _
.SpecialCells(xlVisible)
c1.Value = c.Value
c2.Resize(, 21).Value = c.Offset(, 1).Resize(, 21).Value
Set c1 = c1.Offset(1) '次の転記先セル
Set c2 = c2.Offset(1)
Next
Rng1.Worksheet.ShowAllData
End Sub
> Set c1 = c1.Offset(1) '次の転記先セル
のところは、現在のセルから [↓]キーを一回押した操作に相当します。
たとえば、
「抽出リスト」シートの[A1]にカーソルをおいて [↓]を一度
押してください。
どこに移動しましたか？
[A2]セルですよね。
今度は
「抽出」シートの[C5:C6]結合セルにカーソルをおいて[↓]キーを
一回押してみてください。
どこへ移動しましたか？
[C5:C6]は結合セルだから [↓]により [C7]セル（正確には [C7:C8]
セル）に移動します。
これが
> Set c1 = c1.Offset(1)
の意味です。
|
|
kanabun
- 12/8/9(木) 14:26 -
