マトリクス表へのデータ設定高速化

質問

office2010

index関数で別シートを参照してデータ設定する構成だと、データ数が多い場合に
時間がかかるので、高速化を実現したい。

sheet1：マトリクス表イメージのシート
J2セルに2019/01/01という日付が入っている
K2セル2019/01/02、L2セル2019/01/03以降、右方向へ+1日ずつのデータが入っており、IR2セルが2019/08/31までのデータが設定されている。
J1セルは、=TEXT(J2,"YYYYMMDD")という式で、日付を8桁の文字列表現にしたデータ設定している。
J1が20190101、K1が20190102、IR1が20190831までのデータが設定されている
A6セルからA538セルまでは、8桁の文字列データが入っている。
ABCD0001、ABCD0002の様なデータで重複番号は無い。
先頭4桁が文字列、右４桁が数字の構成。
E6セルからE538セルまでは、Ａ列の番号を抜き出す式　=RIGHT(A6,4)が設定されている。
J6セルからIR538セルまでにWORKシートのデータを参照した結果を設定する。
なお、番号の先頭、開始がセットされた、１つ左のセルには、E列の４桁の番号をセットする構成。

WORKシート
A2セルからA4801セルまで番号データが設定されている。
B2セルからB4801セルまで、Ａの番号に関連する文字列データが登録されている。
E2セルからE4801まで、日付と番号を合体させたデータを設定している。
A列　　　　B列　　　　　E列
ABCD0001　開始　　　　20190220ABCD0001
ABCD0001　x1　　　　　20190221ABCD0001
ABCD0001　X2　　　　　20190222ABCD0001
ABCD0001　X3　　　　　20190223ABCD0001
ABCD0001　X4　　　　　20190224ABCD0001
ABCD0001　X5　　　　　20190225ABCD0001
ABCD0001　X6　　　　　20190226ABCD0001
ABCD0002　開始　　　　20190221ABCD0002
ABCD0002　x1　　　　　20190222ABCD0002
ABCD0002　X2　　　　　20190223ABCD0002
ABCD0002　X3　　　　　20190224ABCD0002
ABCD0002　X4　　　　　20190225ABCD0002
ABCD0002　X5　　　　　20190226ABCD0002
ABCD0002　X6　　　　　20190227ABCD0002
…
XXXX0047　X6　　　　　20190830XXXX0047

シート１のイメージ
　　　　　　　　　　　　　20190220　20190221　20190222　20190223

ABCD0001 0001 　　0001　開始　　　　　X1　　　　　X2　 　　　　X3
ABCD0002 0002　　　　　　0002　　　　開始　　　　　X1　　　　　X2

これを設定する計算式が下記で、結果が#N/Aになるのは非表示としている
Range(Cells(6, 10), Cells(Range("A" & Rows.Count).End(xlUp).Row, Cells(2, Columns.Count).End(xlToLeft).Column)).Value = _
"=IF(RC[1]=""開始"",RC5,IF(ISNA(INDEX(WORK!C2,MATCH(R1C&RC1,WORK!C5,0))),"""",INDEX(WORK!C2,MATCH(R1C&RC1,WORK!C5,0))))"

上記の計算を実施すると2分くらいかかるので、もっと早く対応可能な構成にしたい。
Webでいろいろ調べた所、配列を使用すると高速化可能というのが分かったのですが、上記の通り、式が複雑なので、対応できない次第です。
配列でなくても、短い時間でシート１のイメージの様にデータが設定されるマクロを教えて頂きたく。
よろしくお願いします。

回答No.2

HohoPapa · ベストアンサー

添付画像のレイアウトなら
こんなコードでいかがでしょうか？

Option Explicit

Sub Sample()

　Dim tgtBk As Workbook
　Dim GetSh As Worksheet
　Dim PutSh As Worksheet
　Dim RowCounter As Long　'行カウンター

　Dim Rowadr As Long　'出力先行番号
　Dim Coladr As Long　'出力先列番号

　Set tgtBk = ThisWorkbook
　Set GetSh = ThisWorkbook.Sheets("work")
　Set PutSh = ThisWorkbook.Sheets("Sheet1")

　RowCounter = 2
　Do
　　If GetSh.Cells(RowCounter, 1).Value = "" Then Exit Do
　　Rowadr = GetRowNum(PutSh, GetSh.Cells(RowCounter, 1).Value)
　　Coladr = GetColNum(PutSh.Cells(2, 10).Value, GetSh.Cells(RowCounter, 7).Value)
　　If ((Rowadr > 5) And (Coladr > 9)) Then
　　　PutSh.Cells(Rowadr, Coladr).Value = GetSh.Cells(RowCounter, 2).Value
　　Else
　　　MsgBox ("出力先アドレス算出不能 行：" & Format(RowCounter, "0"))
　　End If
　　RowCounter = RowCounter + 1
　Loop

End Sub

'//行番号取得関数
Function GetRowNum(TblSh As Worksheet, BData As String) As Long
　Dim RowCounter As Long
　RowCounter = 6
　GetRowNum = 0
　Do
　　If TblSh.Cells(RowCounter, 1).Value = "" Then Exit Do
　　If TblSh.Cells(RowCounter, 1).Value = BData Then
　　　GetRowNum = RowCounter
　　　Exit Do
　　End If
　　RowCounter = RowCounter + 1
　Loop
End Function

'//列番号取得関数
Function GetColNum(SDate As Date, MData As String) As Long
　Dim wkDate As Date
　wkDate = DateSerial(Left(MData, 4), Mid(MData, 5, 2), Mid(MData, 7, 2))
　GetColNum = wkDate - SDate + 10
End Function

お礼

回答ありがとうございます。
助かりました。
もの凄く早く出来ました。
15[s]くらいで完了です。

※
なお、番号の先頭、開始がセットされた、１つ左のセルには、E列の４桁の番号をセットする構成。

が無かったので、次の様に対応しました。

　　PutSh.Cells(Rowadr, Coladr).Value = GetSh.Cells(RowCounter, 2).Value

→ここに追加

　　Else

下記を追加
If PutSh.Cells(Rowadr, Coladr).Value = "開始" Then

Dim a As String

a = Cells(Rowadr, 5).Value
PutSh.Cells(Rowadr, Coladr - 1).Value = a

End If

また、書き込むセルが、数値４桁表現されなかったのでセル自体を文字列としました。

回答No.1

山田 太郎（@f_a_007）

Q、マトリクス表へのデータ設定高速化法。
A、VBAでプログラミングする。

＞別シートを参照してデータ設定する構成だと・・・

　この別シートが、一日単位で更新されると仮定。で、更新後に配列に呼び込んで利用できると仮定。この二つの仮定が成立すれば、セットする値の確定に要する時間は、0.001秒以下。後は、シートを更新する時間だけです。

Step1、別シートを更新する都度に、そのデータをバイナリーファイルとして排出する。

・バイナリーデータのレコードは１行の構造体変数。

Step2、VBAで構造体変数を呼び込み、一気に処理する。

で、無事に高速化が達成されると思います。

お礼

回答ありがとうございます。