| |
とりあえず、すべて人任せのところがある為
わからないなりに自分で考えて作ってみました。(下記に載せました)
支離滅裂な感じですが、一応動きました。
データが増えた場合この処理ではどうなのかわからないですが・・・
最後にデータをエクセルシートに処理する際に
繰り返し処理にて展開してますが一括での感じがわかりません
やはりDictinaryのほうがシンプルに処理できそうなのでことらを
これからも使用します。今回はアドバイスいただきありがとうございました。
Sub 展開()
Dim myval0(), myval, myval1(), myval2(), myval3() 'データ入力用配列の宣言
Dim Myoutpt, Myoutpt1(), Myoutpt2(), Myoutpt0(), Myoutpt3() '出力用配列の宣言
Dim msg
Dim 品番1 As Range
Dim 品番2 As Range
'--------------------------------------------------------
Dim sh1 As Worksheet 'シート宣言
Dim sh As Worksheet
'-----------------------------------変数(Long型作成) 宣言
Dim a As Long
Dim b As Long
Dim d As Long
Dim h As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long
Dim m As Long
Dim n As Long
'---------------------------------------
Application.ScreenUpdating = False '画面停止処理
Set sh = Worksheets("データ取り込み") 'Sh＝データ取り込みシート
Set sh1 = Worksheets("集計") ' Sh1=集計シート
'入力用配列の作成------------------------------------------------------------
myval = sh.Range("A1").CurrentRegion.Value 'データ取り込みシートのデータを配列に格納する
ReDim myval1(2 To UBound(myval, 1)) '配列要素数を設定する
For i = 2 To UBound(myval, 1)
myval1(i) = myval(i, 1) & myval(i, 2) '品番データを配列に格納する
Next
ReDim myval2(3 To (UBound(myval, 2) - 4)) '配列要素数を設定する
For n = 3 To (UBound(myval, 2) - 4) '納期データを配列に格納する
myval2(n) = myval(1, n)
Next
ReDim myval0(2 To UBound(myval, 1), 3 To (UBound(myval, 2) - 4)) '配列要素を設定
For a = 2 To UBound(myval, 1)
For b = 3 To UBound(myval, 2) - 4 '計画数をデータに確保する
myval0(a, b) = myval(a, b)
Next
Next
n = 2
d = 3
ReDim myval3(2 To UBound(myval1, 1), 3 To UBound(myval2, 1)) '配列要素数を設定する
For l = 2 To UBound(myval1, 1) 'すべての情報を配列に格納する
For m = 3 To UBound(myval2, 1)
myval3(l, m) = Split(myval1(l) & "_" & myval2(m) & "_" & myval0(n, d), "_") 'データを区切って連結させる
If d = UBound(myval0, 2) Then
n = n + 1
d = 3
If n = UBound(myval0, 1) Then
Exit For
End If
Else
d = d + 1
End If
Next
Next
'出力用配列作成--------------------------------------------
Myoutpt = sh1.Range("A1").CurrentRegion.Value 'データ取り込みシートのデータを配列に格納する
ReDim Myoutpt1(2 To UBound(Myoutpt, 1)) '配列要素数を設定する
For i = 2 To UBound(Myoutpt, 1)
Myoutpt1(i) = Myoutpt(i, 1) & Myoutpt(i, 2) '品番データを配列に格納する
Next
ReDim Myoutpt2(4 To (UBound(Myoutpt, 2))) '配列要素数を設定する
For n = 4 To (UBound(Myoutpt, 2)) '納期データを配列に格納する
Myoutpt2(n) = Myoutpt(1, n)
Next
ReDim Myoutpt0(2 To UBound(Myoutpt, 1), 4 To UBound(Myoutpt, 2)) '配列要素を設定
For a = 2 To UBound(Myoutpt, 1)
For b = 4 To UBound(Myoutpt, 2) '計画数をデータに確保する
Myoutpt0(a, b) = Myoutpt(a, b)
Next
Next
ReDim Myoutpt3(2 To UBound(Myoutpt1, 1), 4 To UBound(Myoutpt2, 1)) '配列要素数を設定する
For l = 2 To UBound(Myoutpt1, 1) 'すべての情報を配列に格納する
For m = 4 To UBound(Myoutpt2, 1)
Myoutpt3(l, m) = Split(Myoutpt1(l) & "_" & Myoutpt2(m) & "_" & Myoutpt0(l, m), "_") 'データを区切って”＿”で連結させる
Next
Next
For j = LBound(Myoutpt3, 1) To UBound(Myoutpt3, 1)
For i = LBound(Myoutpt3, 2) To UBound(Myoutpt3, 2)
For k = LBound(myval3, 1) To UBound(myval3, 1)
For l = LBound(myval3, 2) To UBound(myval3, 2)
If j > UBound(myval3, 1) Then 'データ取り込みの品番に新規があり上限が増えた場合処理しない
Exit For
End If
If Myoutpt3(j, i)(0) & Myoutpt3(j, i)(1) = myval3(k, l)(0) & myval3(k, l)(1) Then '品番＆納期の照合をして同じ場合値を取得
Myoutpt3(j, i)(2) = myval3(k, l)(2)
Else
Myoutpt3(j, i)(2) = Myoutpt3(j, i)(2) '集計でーたにすでに値があり、今回取り込み対象外の場合集計のセルデータを登録
End If
Next
Next
Next
Next
'------------------------------------------------------- 集計シートに値を出力する
For i = 2 To UBound(Myoutpt3, 1)
sh1.Cells(i, 3).Value = Myoutpt3(i, 4)(0)
Next
For i = 4 To UBound(Myoutpt3, 2)
sh1.Cells(1, i).Value2 = Myoutpt3(2, i)(1)
Next
For m = LBound(Myoutpt3, 1) To UBound(Myoutpt3, 1)
For n = LBound(Myoutpt3, 2) To UBound(Myoutpt3, 2)
sh1.Cells(m, n) = Myoutpt3(m, n)(2)
Next
Next
'----------------------------------------------------------------------集計シート品番とデータ取り込みシートのデータを照合して違う場合色で表示する
Set 品番1 = sh.Range("A1:A1000")
Set 品番2 = sh1.Range("A1:A1000")
'bも同じようにしてください。
'カウンタが1からセルの個数になるまで繰り返し処理
For i = 1 To 品番1.Cells.Count
If 品番1.Cells(i).Value <> 品番2.Cells(i).Value Then
品番1.Cells(i).Interior.ColorIndex = 6
End If
Next i 'この行に来たら「For 〜」の行に勝手に戻
'-----------------------------------------------------------------------
Application.ScreenUpdating = True '画面更新をOKにする
MsgBox "処理終了"
End Sub
|
|
T-K
- 20/7/23(木) 23:51 -
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
