[[20170804155503]] 『Arrayを挿入したい』(ねのこ) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『Arrayを挿入したい』(ねのこ)

こんにちは。下記コードにArrayを入れたいのですが上手く入れられません。
どこにArrayを入れたら上手く動くのかどなたかご教示下さい。

<やりたいこと>

シートAのB2セルにキーワードを入力。マクロ起動で別ファイルのリストB内から先ほど指定したキーワードに一致する行を探し、検索結果をシートAのB3以下に集約・表示させる。

この際、リストB(A〜Z列)から任意の列をArrayで指定しシートAに表示されるようにしたい。

現状、リストBから指定した列の範囲分だけをそのまま抽出している状態です。リストBから指定した列の範囲分だけ、列をしていしたいのですが(リストBの1,4,5,8列目だけシートAに出すという感じ)添削をお願いできますでしょうか?


    Dim dic As Object
    Dim wb As Workbook
    Dim shT As Worksheet
    Dim shF As Worksheet
    Dim c As Range
    Dim f As Range
    Dim wd As String
    Dim i As Long
    Dim k As String
    Dim W As Worksheet

    Application.ScreenUpdating = False
    On Error Resume Next

    Set shT = ThisWorkbook.Sheets("シートA")     'Aに検索結果集約
    Set dic = CreateObject("Scripting.Dictionary")  '重複転記回避

    wd = shT.Range("B2").Value              'キーワード入力場所
    i = 3                                   '転記開始行
    shT.Range(shT.Rows(3), shT.Rows(shT.Rows.Count)).Columns("B:H").ClearContents    'A3以下B:Hの入力範囲を選択しクリア

    Set wb = Workbooks.Open("リストB")

    For Each shF In wb.Worksheets
        With shF.Range("A1", shF.UsedRange)
            Set c = .Find(What:=wd, LookAt:=xlPart, After:=.Cells(.Cells.Count))
            If Not c Is Nothing Then
                Set f = c
                Do
                    k = shF.Name & ":" & c.Row
                    If Not dic.exists(k) Then   'この行が未転記なら
                        shT.Cells(i, "B").Resize(, 10).Value = c.EntireRow.Columns("A:Z").Value 'リストBのA-Zの中からシートAに10列分転記)

                        dic(k) = True           '転記済み
                        i = i + 1               '次の転記行
                    End If
                    Set c = .FindNext(c)
                Loop While c.Address <> f.Address
            End If
        End With
    Next

    wb.Close False

 End Sub

< 使用 Excel:Excel2013、使用 OS:Windows7 >


これでどうなりますか

 shT.Cells(i, "B").Resize(, 4).Value = _
    Application.Index(c.EntireRow.Columns("A:Z").Value, Array(1, 4, 5, 8))

(マナ) 2017/08/04(金) 19:12


ありがとうございます!
(ねのこ) 2017/08/09(水) 09:43

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.