Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10全般 : Excel 2016)
100以上あるINDEX関数とMATCH関数を簡素化したい
投稿日時: 20/02/18 16:43:24
投稿者: vaioyuki

いつもお世話になっております。
 
現在、Worksheets(3)から読み取ってWorksheets(5)に入力しています。
 

Public Sub test()
Dim i As Integer
Dim ix As Long
Dim GoSerchRangeI As Range
Dim GoSerchRangeM As Range

With Worksheets(3)
    r_cnt = .Range("A1").CurrentRegion.Rows.Count
    
    Set GoSerchRangeI = .Range("A1").CurrentRegion
    Set GoSerchRangeM = .Range("A1:A" & r_cnt)
End With

With Worksheets(5)
    For i = 2 To r_cnt
        ix = WorksheetFunction.Match(.Cells(i, 3), GoSerchRangeM, 0)
            
        Cells(i, 49) = WorksheetFunction.Index(GoSerchRangeI, ix, 2)
        Cells(i, 50) = WorksheetFunction.Index(GoSerchRangeI, ix, 3)
        Cells(i, 51) = WorksheetFunction.Index(GoSerchRangeI, ix, 4)
        Cells(i, 52) = WorksheetFunction.Index(GoSerchRangeI, ix, 5)
     ・
     ・
     ・
     ・
     ・

    Next
            
End With

End Sub

 
この動作が100以上続きます。
空白列もありますが配列はほぼ同じです。
 
何か100行も書かずに出来る方法はありませんか?
 
 
前任者は
 
        Sht_wh.Activate
        For j = 49 To 148
            Sht_ho.Cells(i, j).Value = Application.VLookup(Sht_ho.Cells(i, 3).Value, Range(Cells(1, 1), Cells(r_cnt_wh, 101)), j - 47, False)
        Next

 
このようなコードを書いていたのですがこの作業に20分以上かかるので前にお聞きしたINDEX関数とMATCH関数を組み合わせたほうが早いのではないかと思いお聞きしました。
(VLOOKUP関数からINDEX関数とMATCH関数を使えるように少しだけですが上達しました。笑)
 
よろしくお願いします。

回答
投稿日時: 20/02/18 18:55:56
投稿者: takesi

単純に

Dim Col As Long
For i = 2 To r_cnt
    ix = WorksheetFunction.Match(.Cells(i, 3), GoSerchRangeM, 0)
    For Col = 49 To 148
        .Cells(i, Col) = WorksheetFunction.Index(GoSerchRangeI, ix, Col - 47)
    Next
    
Next

.Cells(i, Col) ドット足したけど、間違い?
  
  
あとは画面更新を止めることですかね
Application.ScreenUpdating = False

Application.ScreenUpdating = True

回答
投稿日時: 20/02/19 00:06:59
投稿者: simple

既に指摘がありました方法に加え、
(1)マクロの最初で、Applcation.Calculationを手作業にし、処理終了後に元の自動に戻す。
(2)結果をいったん配列に書き出し、最後にまとめてワークシートに書き出す。
という二つのことを実行すると速度が上がると思います。

回答
投稿日時: 20/02/19 12:41:59
投稿者: mattuwan44

Public Sub test()
    Dim rngList As Range        '一覧表のセル範囲
    Dim rngSearch As Range      '検索する列のセル範囲
    Dim rngKey As Range         '検索するキーワードが入っているセル範囲
    Dim c As Range              'セル範囲の中の各セル(検索する各キーワードのセル)
    Dim ixRow As Long           '検索した値が検索する列のセル範囲の何番目という情報

    Set rngList = Worksheets(3).Range("A1").CurrentRegion
    Set rngSearch = rngList.Columns(1)
    With Worksheets(5).Range("A1").CurrentRegion
        Set rngKey = Intersect(.Columns(1), .Offset(1))
    End With

    For Each c In rngKey
        ixRow = WorksheetFunction.Match(c.Cells, rngSearch.Cells, 0)
        c.Offset(, 1).Resize(, 100).Value = rngList.Rows(ixRow).Offset(, 1).Value
    Next
End Sub

 
Index関数でやってることは、
セル範囲のなかのn番目の行のm番目の列の位置の値を参照するということなので、
それはVBAでは、
Range("A1:C5").cells(n,m)
で表現できますので、Index関数を使う必要はないです。
 
>空白列もありますが配列はほぼ同じです
ということは、「違う」ということですよね?
ここの部分はもう一工夫必要になりそうです。
 
まずは、日本語で、操作したいセル範囲を表現できるようになりましょう。
 
見ているセルの1つ右から100列分のセル範囲
c.Offset(, 1).Resize(, 100)
 
セル範囲の中の見つけた位置の行を1列右にずらしたセル範囲
rngList.Rows(ixRow).Offset(, 1)

投稿日時: 20/02/19 17:16:16
投稿者: vaioyuki

みなさん、ありがとうございます。
 

Public Sub test()
Dim i As Integer
Dim ix As Long
Dim Cok As Long
Dim GoSerchRangeI As Range
Dim GoSerchRangeM As Range

Debug.Print Time
Application.ScreenUpdating = False

With Worksheets(3)
    Set GoSerchRangeI = .Range("A1").CurrentRegion
    Set GoSerchRangeM = .Range("A1:A" & r_cnt)
End With

With Worksheets(5)
    For i = 2 To r_cnt
        ix = WorksheetFunction.Match(.Cells(i, 3), GoSerchRangeM, 0)
        For Col = 49 To 148
            .Cells(i, Col) = WorksheetFunction.Index(GoSerchRangeI, ix, Col - 47)
        Next
    Next
Application.ScreenUpdating = True
          
End With

Debug.Print Time

MsgBox "END"

End Sub

 
こちらで1分くらいの処理時間で済みました。
前にこちらでもご指摘があったように、前任者が使っていた(私もまだ使ってしまいますがw)VLOOKUP関数は大量データで使用するには時間がかかるんですね。。。
 
 
本当にありがとうございました。
まだまだ勉強します!!