|
お邪魔します。当方Excel2013使用です。
発注明細をデータベースっぽく一覧に転記していこうとしています。
勉強中ですので、質問点以外にもお気づきの改善点ありましたらご指摘ください。
入力元には伝票番号のような『ヘッダ』要素と
それに対して複数の『明細』があります。
先方に合わせたいくつかの書式があり、下記コードはそのうちの一部です。
フィルター機能の等を利用したいので、貼付先は『テーブル』機能を利用しています。
この場合、1行でも先にデータがあればそれ以降は問題ないのですが、
最初の明細(2行目に入ってほしい)データが
どうしてもテーブルの外になる3行目から転記されてしまいます。
転記先の行番号についての記述がおかしいのか?とも思いましたが
そうでもなさそうですし、かと言っていろいろ検索かけても
そんなところで躓いている人を見つけられず…
このままでも最初の一回だけ手作業でコピペすれば使えなくはないのですが、
将来的に利用するのは私だけではない予定なので、
できればなんとか改善したいと考えてます。
よろしければご教授ください。宜しくお願いします。
Sub 明細保存()
Dim wst1 As Worksheet 'コピー元
Dim wst2 As Worksheet '転記先
Dim i As Long 'ループ用
Dim myRow As Long '貼付先行番号
Dim No As Long '伝票番号
Set wst1 = ActiveSheet '入力元が複数パターンあるので
Set wst2 = ThisWorkbook.Worksheets("DB")
If wst2.Range("A" & Rows.Count).End(xlUp).Row = 1 Then '最初の伝票番号
No = 1
Else
No = wst2.Range("A" & Rows.Count).End(xlUp).Value + 1
End If
For i = 21 To 47
If wst1.Range("G" & i) = "" Then
Exit For
Else
myRow = wst2.Cells(Rows.Count, 1).End(xlUp).Row + 1
wst2.Range("A" & myRow).Value = No '伝票番号
wst2.Range("B" & myRow).Value = wst1.Range("H2").Value '日付
wst2.Range("C" & myRow).Value = wst1.Range("A3").Value '発注先
wst2.Range("D" & myRow).Value = wst1.Range("B9").Value '件名
wst2.Range("E" & myRow).Value = wst1.Range("B11").Value '納品先
wst2.Range("F" & myRow).Value = wst1.Range("I15").Value '発注者
wst2.Range("G" & myRow).Value = wst1.Range("A" & i).Value '品名
wst2.Range("H" & myRow).Value = wst1.Range("D" & i).Value '仕様
wst2.Range("I" & myRow).Value = wst1.Range("G" & i).Value '数量
wst2.Range("J" & myRow).Value = wst1.Range("F" & i).Value '単位
wst2.Range("K" & myRow).Value = wst1.Range("H" & i).Value '備考
wst2.Range("L" & myRow).Value = wst1.Range("B14").Value '希望納期
wst2.Range("N" & myRow).Value = "FAX" '注文方法
wst2.Range("O" & myRow).Value = wst1.Range("A18").Value '伝票備考1
wst2.Range("P" & myRow).Value = wst1.Range("A19").Value '伝票備考2
End If
Next i
End Sub
|
|