| |
▼kanabun さん：
>こんばんは。
>
>> わからないのは、2)品名と行番号の対応表を用意する部分
>>
>> 品名List = 品名.Value この処理ですが品名の値(商品名)だと思いますが、
>> For i = 1 To UBound(品名List)この文でFor〜Next文1から最大値(添え字？)
>> の範囲を処理する部分が、前に書いてある、
>>>' dic("A品名") = 1
>>>' dic("B品名") = 2
>>>' dic("C品名") = 3
>> を辞書に登録してないとうごかないのでしょうか？
>> 上記登録は、モジュールにするのだとおもいますが、どこに入力しておくと処理
>> されるのでしょうか？
>
>>> Set dic = CreateObject("Scripting.Dictionary")
>>> For i = 1 To UBound(品名List)
>>> dic(品名List(i, 1)) = i
>>> Next
>で、書き込み先の「品名」が 何行目にあるか をDictionary に記憶
>しておくということです。
>
>要は、
> ＜シート２＞(データベース)
>のほうから
>データ 100 を ＜シート１＞の「A品名」の行の 5/15 の列に、
>データ 200 を ＜シート１＞の「A品名」の行の 5/18 の列に、
>データ 500 を ＜シート１＞の「A品名」の行の 5/30 の列に、
>データ 100 を ＜シート１＞の「B品名」の行の 5/15 の列に
>…
>転記すればいいのですが、毎回 「A品名」は何行目にあるか？
>「C商品」は何行目にあるか?
>Ｆｉｎｄ やMatch 関数使って 都度調べるよりも、最初に1回だけの走査で
>＜シート1＞のA列の各品名（行見出し）が何行目にあるか行番号を
>あらかじめ記憶しておけば、
>
> データ 100 を ＜配列＞の (1,1) 要素位置に、
> データ 200 を ＜配列＞の (1,4) 要素位置に、
> データ 500 を ＜配列＞の (1,15) 要素位置に、
> データ 100 を ＜配列＞の (2,1) 要素位置に、
> …
>簡単にすばやく格納できるということなんです。
>
>
>>後 Dim date0 As Long
>> date0 = 日付.Item(1).Value2 - 1 'つまり 5/14のシリアル値
>> のItem(1).Value２-1 ’5/14を求める理由がわからない
>> x = CLng(data(i, 2)) - date0’
>> この部分の意味がわかりません
>
>.Value2 プロパティはデータの内部格納値のことで、
>Value が 2008/5/15 という日付のとき、 Value2 は 39583 という倍精度値です。
>いま、data(i, 2) が 2008/5/15 であれば、
>> x = CLng(data(i, 2)) - date0’
>は、
> x = CLng(#2008/5/15#) - 39582
>すなわち、
> x = 39583 - 39582
>で、結局 x = 1 が返ります。書き込む列番号は 1 ということです。
>
>
>> 後まったくそのまま使用して下記部分でデバッグがでます
>> arry(y, x) = data(i, 3) 'インデックスが有効範囲にありませんと表示される
>デバッグで中断しているときに、 コード上の y や x や i のうえにマウス
>カーソルをあてがうと、それら変数の現在の値が表示されます。
>この現在値が Redimで宣言した配列の要素数のなかにおさまってないと
>> インデックスが有効範囲にありません
>となります。
答えいただきありがとうごうざいます。粘りずよい説明のおかげで、100％とまではいかないまでも内容は6割〜7割理解できたとおもいます。あとは、自分なりにプログラムができるようになるため、日々努力と勉強ですね。一応そのまま利用さしてもらいインデックスの問題も
調べて解決して期待どうりの処理ができました。ほんとにありがとうございます。
一応データ取り込みしてからの一連の処理までのプログラムを記入します。
'’データ取り込み部分''
Sub 取込()
Application.ScreenUpdating = False '画面の移動停止
Dim vri As Variant 'Vriをvariant型で宣言(メモリー格納)
vri = Application.GetOpenFilename( _
Filefilter:="テキストファイル,*.csv,", _
Title:="他のファイルを開く", _
MultiSelect:=False)
'ファイルを開く処理
If vri = False Then
MsgBox "ファイルは選択されませんでした。", _
vbOKOnly + vbExclamation, "ファイル名の入力チェック"
Exit Sub
'ファイルが選択されない場合エラーメッセージ処理する
Else
Workbooks.Open (vri)
'選ばれた場合は選択したCSVファイルを開く
End If
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy 'CSVファイルのデータ選択してコピー
Windows("SHINBA.xls").Activate 'SHINBAxlsに移動
Sheets("データ取込").Select '（データ取込）シートに移動
Range("A1").Select 'セルA1を選択してデータを貼り付け処理する
ActiveSheet.Paste
Union(Columns("A"), Columns("C:d"), Columns("F"), _
Columns("I"), Columns("K")).Select
Selection.Delete
'選択した列(不要なデータ)を削除する
Range("F1").Activate 'セルF1に移動する
With Range("F1") 'F1に対しての処理(Withステートメントの開始)
.FormulaR1C1 = "=RC[-1]&RC[-4]" '文字連結
.AutoFill Destination:=Range("F1", Range("E" & Rows.Count).End(xlUp).Offset(, 1)), _
Type:=xlFillDefault
'指定行までオートフィルする
End With '（Withステートメントの終了）
Range("F1", Range("F65536").End(xlUp)).Select
Selection.Copy '文字連結したセルを選択してコピーする
Range("G1").Activate 'G1へ移動
Selection.PasteSpecial Paste:=xlPasteValues '値のみ貼り付け
Range("H1").Activate 'H1へ移動
ActiveCell.FormulaR1C1 = "=TRIM(RC[-1])" 'TRIM関数で文字間の不要なスペースを削除
ActiveCell.AutoFill Destination:=Range("H1", Range("G" & Rows.Count).End(xlUp).Offset(, 1)), _
Type:=xlFillDefault '指定行までオートフィルする
Range("H1", Range("H" & Rows.Count).End(xlUp)).Select
Selection.Copy '指定行まで、コピー
Range("I1").Activate 'セルI1へ移動
Selection.PasteSpecial Paste:=xlPasteValues 'コピーした値を貼り付ける
Union(Columns("B"), Columns("E:H")).Select
Selection.Delete '指定列を削除
Range("A1").Activate
Selection.CurrentRegion.Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="<>0", Operator:=xlAnd
'A列の0以外をオートフィルターでデータを絞り表示
Range("A1").CurrentRegion.Select '文字入力されている範囲を選択
Selection.Copy 'その部分をコピーする
Range("E1").Select
Selection.PasteSpecial Paste:=xlPasteValues 'セルE1を選択して貼り付け
Range("A1").Select
Selection.AutoFilter Field:=1
Application.CutCopyMode = False
Selection.AutoFilter 'オートフィルターを解除してコピー処理を停止する
Columns("A:E").Select '列 A〜Eを選択
Selection.Delete '選択した範囲を、削除する
Columns("A").Select '列Aを選択する
Selection.Insert '列Aを挿入する
Columns("D").Select
Selection.Copy '列Dを選択してコピーする。
Columns("A").Select
Selection.PasteSpecial Paste:=xlPasteValues '列Aを選択して、貼り付ける
Application.CutCopyMode = False 'コピー処理を中止する
Columns("D").Select
Selection.Delete '列Dを選択して削除する。
Range("A1", Range("C" & Rows.Count).End(xlUp)).Select '値のある部分を選択
Selection.Copy '選択したセルをコピーする
Sheets("展開").Activate 'シート("展開")に移動
If Sheets("展開").Range("A1") = "" Then 'A1が空白なら下記処理を実行
Range("A1").Select 'セルA1を選択
Selection.PasteSpecial Paste:=xlPasteValues '値のみ貼り付け
Else
Sheets("展開").Range("A1").End(xlDown).Offset(1, 0).Select '最終行を選択
Selection.PasteSpecial '値を貼り付け
Columns("A:C").Select '列A〜Cを選択
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
'品番、納期の順番で昇順に並べ替える
End If
Application.CutCopyMode = False
'コピーする処理を中止する
Columns("B").Select '列Bを選択
Selection.NumberFormatLocal = "yyyy/m/d" '日付形式に変換
Sheets("メニュー画面").Activate 'メニュー画面に戻る
Application.ScreenUpdating = True '画面の移動実行
MsgBox "データ取込終了" '取込み終了メッセージ
End Sub
''教えていただいたプログラム''
Sub 展開()
Dim arry 'arryを動的配列変数(Variant)を宣言
Dim 品名 As Range '品名を、Rangeの型で宣言
Dim 日付 As Range '日付をRange型で宣言
Dim 行数 As Long, 列数 As Long '行数 列数をそれぞれLong型で宣言
Dim 品名List, Ls
Dim Dic As Object 'dicをObject型で宣言
Dim i As Long 'ｉをLong型で宣言
Dim date0 As Long ' 'Date0をLong型で宣言
Dim data 'Detaを宣言(variant)
Dim y As Long, x As Long 'xyをLong型で宣言
With Sheets("ﾃﾞｰﾀｼｰﾄ") 'ﾃﾞｰﾀｼｰﾄに対してそれぞれ処理する
Set 品名 = .Range("A2", .Range("A65536").End(xlUp)) '品名の行の範囲指定
Set 日付 = .Range("B1", .Range("IV1").End(xlToLeft)) '日付の列の範囲指定
End With 'With 処理の終了
行数 = 品名.Rows.Count '行の数
列数 = 日付.Columns.Count '列の数
ReDim arry(1 To 行数, 1 To 列数) '動的配列変数に対するメモリ領域の再割り当てを
品名List = 品名.Value '品名List=ﾃﾞｰﾀｼｰﾄ品名範囲の値
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(品名List) '品名リストの最小値から最大値を変数ｉに代入
Dic(品名List(i, 1)) = i
Next
date0 = 日付.Item(1).Value2 - 1
With Sheets("展開") 'ｼｰﾄ展開にたいして処理
data = .Range("A2", .Range("A65536").End(xlUp)).Resize(, 3).Value '展開のデータ範囲のデータの値
End With
For i = 1 To UBound(data) '展開のデータ範囲のデータ値の最小値から最大値まで順に処理
y = Dic(data(i, 1))
x = CLng(data(i, 2)) - date0 '指定された式をバリアント型 (内部処理形式が長整数型 (Long) の Variant) に変換して返します。
arry(y, x) = data(i, 3)
Next
Sheets("").Range("B2").Resize(行数, 列数).Value = arry
Set Dic = Nothing
End Sub
|
|
T-k
- 08/5/19(月) 23:26 -
