Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


5260 / 76732 ←次へ | 前へ→

【77085】設定済のテーブル内への転記
質問  doro  - 15/5/15(金) 16:32 -

引用なし
パスワード
   お邪魔します。当方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

292 hits

【77085】設定済のテーブル内への転記 doro 15/5/15(金) 16:32 質問[未読]
【77086】Re:設定済のテーブル内への転記 kanabun 15/5/15(金) 17:27 発言[未読]
【77088】Re:設定済のテーブル内への転記 doro 15/5/15(金) 18:00 発言[未読]
【77089】Re:設定済のテーブル内への転記 kanabun 15/5/15(金) 18:40 発言[未読]
【77099】Re:設定済のテーブル内への転記 doro 15/5/18(月) 16:42 発言[未読]
【77087】Re:設定済のテーブル内への転記 kanabun 15/5/15(金) 17:53 発言[未読]

5260 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free