みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

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桁が文字列、右4桁が数字の構成。
E6セルからE538セルまでは、A列の番号を抜き出す式 =RIGHT(A6,4)が設定されている。
J6セルからIR538セルまでにWORKシートのデータを参照した結果を設定する。
なお、番号の先頭、開始がセットされた、1つ左のセルには、E列の4桁の番号をセットする構成。

WORKシート
A2セルからA4801セルまで番号データが設定されている。
B2セルからB4801セルまで、Aの番号に関連する文字列データが登録されている。
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

シート1のイメージ
             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でいろいろ調べた所、配列を使用すると高速化可能というのが分かったのですが、上記の通り、式が複雑なので、対応できない次第です。
配列でなくても、短い時間でシート1のイメージの様にデータが設定されるマクロを教えて頂きたく。
よろしくお願いします。

投稿日時 - 2019-03-19 18:52:10

QNo.9598468

暇なときに回答ください

質問者が選んだベストアンサー

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

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

投稿日時 - 2019-03-20 11:11:25

お礼

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


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

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

  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

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

投稿日時 - 2019-03-20 16:42:04

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.1

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

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

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

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

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

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

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

投稿日時 - 2019-03-20 09:56:27

お礼

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

投稿日時 - 2019-03-20 16:35:37

あなたにオススメの質問