Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
982 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【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 発言[未読]
【77085】設定済のテーブル内への転記
質問  doro  - 15/5/15(金) 16:32 -
引用なし
パスワード
   お邪魔します。当方Excel2013使用です。
発注明細をデータベースっぽく一覧に転記していこうとしています。
勉強中ですので、質問点以外にもお気づきの改善点ありましたらご指摘ください。

入力元には伝票番号のような『ヘッダ』要素と
それに対して複数の『明細』があります。
先方に合わせたいくつかの書式があり、下記コードはそのうちの一部です。

フィルター機能の等を利用したいので、貼付先は『テーブル』機能を利用しています。
この場合、1行でも先にデータがあればそれ以降は問題ないのですが、
最初の明細（２行目に入ってほしい）データが
どうしてもテーブルの外になる３行目から転記されてしまいます。
転記先の行番号についての記述がおかしいのか？とも思いましたが
そうでもなさそうですし、かと言っていろいろ検索かけても
そんなところで躓いている人を見つけられず…

このままでも最初の一回だけ手作業でコピペすれば使えなくはないのですが、
将来的に利用するのは私だけではない予定なので、
できればなんとか改善したいと考えてます。
よろしければご教授ください。宜しくお願いします。


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　　'伝票備考１
　　　wst2.Range("P" & myRow).Value = wst1.Range("A19").Value　　'伝票備考２
　　End If
　Next i
End Sub
【77086】Re:設定済のテーブル内への転記
発言  kanabun  - 15/5/15(金) 17:27 -
引用なし
パスワード
   ▼doro さん：

こんにちは〜
直接には関係ないかもしれないけれど、
ちょっと気になったこと。

>　
>　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

>　　　myRow = wst2.Cells(Rows.Count, 1).End(xlUp).Row + 1
>　　　wst2.Range("A" & myRow).Value = No　　　　　　　　　　　　'伝票番号

↑３つ

＞ wst2.Range("A" & Rows.Count).End(xlUp)

というコードが出てきてます。
（3つ目は wst2.Cells(Rows.Count, 1).End(xlUp) ですが）

１つめの
>　If wst2.Range("A" & Rows.Count).End(xlUp).Row = 1 Then　'最初の伝票番号
ですが、.End(xlUp) して 1行目だったとき、つまり[A1]セルだったとき、
[A1]セルの値をチェックしなくていいんですか？

Case-1. [A1]セルにまだ何も入っていないばあい→ 追加データは1行目に書き込みます

Case-2. [A1]セルに 1 と入っているばあい →データは +1して2行目に書きこむ必要が
　あります。
【77087】Re:設定済のテーブル内への転記
発言  kanabun  - 15/5/15(金) 17:53 -
引用なし
パスワード
   　　　　▼doro さん：

もし、上のようなことが関係しているのなら、
End(xlUp) で求めた最下行が [A1]のとき、
値のある／なし で、以下のように分岐してはいかがでしょう？

Sub 明細保存1()
　Dim wst1 As Worksheet　　 'コピー元
　Dim wst2 As Worksheet　　 '転記先
　Dim i As Long　　　　　　 'ループ用
　Dim LastCell As Range　　 'データ最終セル
　Dim newRow As Long　　　　'貼付先行番号
　Dim No As Long　　　　　　'伝票番号

　Set wst1 = ActiveSheet　　　　 '入力元が複数パターンあるので
　Set wst2 = ThisWorkbook.Worksheets("DB")

　Set LastCell = wst2.Range("A" & Rows.Count).End(xlUp)
　If LastCell.Row = 1 Then　　　　'一行目のとき
　　　If IsEmpty(LastCell) Then　 '未入力なら
　　　　　newRow = 1
　　　　　No = 1
　　　Else　　　　　　　　　　　　'すでに書き込みあれば
　　　　　newRow = 2
　　　　　No = 2
　　　End If
　Else
　　　newRow = LastCell.Row + 1
　　　No = LastCell.Value + 1
　End If

　For i = 21 To 47
　　If wst1.Range("G" & i) = "" Then
　　　　Exit For
　　Else
　　　With wst2.Range("A" & newRow)
　　　　.Value = No　　　　　　　　　　　　'伝票番号
　　　　.Range("B1").Value = wst1.Range("H2").Value　　'日付
　　　　.Range("C1").Value = wst1.Range("A3").Value　　'発注先
　　　　.Range("D1").Value = wst1.Range("B9").Value　　'件名
　　　　.Range("E1").Value = wst1.Range("B11").Value　　'納品先
　　　　.Range("F1").Value = wst1.Range("I15").Value　　'発注者
　
　　　　.Range("G1").Value = wst1.Range("A" & i).Value　　'品名
　　　　.Range("H1").Value = wst1.Range("D" & i).Value　　'仕様
　　　　.Range("I1").Value = wst1.Range("G" & i).Value　　'数量
　　　　.Range("J1").Value = wst1.Range("F" & i).Value　　'単位
　　　　.Range("K1").Value = wst1.Range("H" & i).Value　　'備考
　
　　　　.Range("L1").Value = wst1.Range("B14").Value　　'希望納期
　　　　.Range("N1").Value = "FAX"　　'注文方法
　　　　.Range("O1").Value = wst1.Range("A18").Value　　'伝票備考１
　　　　.Range("P1").Value = wst1.Range("A19").Value　　'伝票備考２
　　　End With
　　　newRow = newRow + 1　'つぎの行
　　End If
　Next i
End Sub
【77088】Re:設定済のテーブル内への転記
発言  doro  - 15/5/15(金) 18:00 -
引用なし
パスワード
   ▼kanabun さん：
こんにちは。大変素早い返信、ありがとうございます。助かります。

>↑３つ
>＞ wst2.Range("A" & Rows.Count).End(xlUp)
>というコードが出てきてます。

微妙に違うのはいろんなサイトさんでコピペさせて頂いているから
というお恥ずかしい話ですが…この辺もWithでまとめられるものでしょうか？
『なんだかなぁ…』とは思っていたんですが、
言われてみればいけるような気がしてきました。
ちょっと後日試してみます。


>１つめの
>>　If wst2.Range("A" & Rows.Count).End(xlUp).Row = 1 Then　'最初の伝票番号
>ですが、.End(xlUp) して 1行目だったとき、つまり[A1]セルだったとき、
>[A1]セルの値をチェックしなくていいんですか？
>
>Case-1. [A1]セルにまだ何も入っていないばあい→ 追加データは1行目に書き込みます
>
>Case-2. [A1]セルに 1 と入っているばあい →データは +1して2行目に書きこむ必要が
>　あります。

1行目だったときは、テーブルの項目行しかないときで、
＝データがまだない状態と想定しています。
なので、その場合の伝票番号は『1』に設定したいのです。
…記述漏れで申し訳ありませんが、テーブル側に関数等も設定されていて、
テーブルはないと困るので今回はテーブル自体がない場合は想定しませんでした。
【77089】Re:設定済のテーブル内への転記
発言  kanabun  - 15/5/15(金) 18:40 -
引用なし
パスワード
   ▼doro さん：

>
>1行目だったときは、テーブルの項目行しかないときで、
>＝データがまだない状態と想定しています。
>なので、その場合の伝票番号は『1』に設定したいのです。

つまり、End(xlUp)で求めた最終行が1行目なら、項目行だけ書き込んである状態
ということで、データ書き込み行は自動で 2行目、No は 1 ということですか？

なら、以下でどうですか？

Sub 明細保存2()
　Dim wst1 As Worksheet　　 'コピー元
　Dim wst2 As Worksheet　　 '転記先
　Dim i As Long　　　　　　 'ループ用
　Dim LastCell As Range　　 'データ最終セル
　Dim newRow As Long　　　　'貼付先行番号
　Dim No As Long　　　　　　'伝票番号

　Set wst1 = ActiveSheet　　　　 '入力元が複数パターンあるので
　Set wst2 = ThisWorkbook.Worksheets("DB")

　Set LastCell = wst2.Range("A" & Rows.Count).End(xlUp)
　If LastCell.Row = 1 Then　　　　'一行目のとき = 項目行だけのとき
　　　newRow = 2
　　　No = 1
　Else
　　　newRow = LastCell.Row + 1
　　　No = LastCell.Value + 1
　End If

　For i = 21 To 47
　　If wst1.Range("G" & i) = "" Then
　　　　Exit For
　　Else
　　　With wst2.Range("A" & newRow)
　　　　.Value = No　　　　　　　　　　　　'伝票番号
　　　　.Range("B1").Value = wst1.Range("H2").Value　　'日付
　　　　.Range("C1").Value = wst1.Range("A3").Value　　'発注先
　　　　.Range("D1").Value = wst1.Range("B9").Value　　'件名
　　　　.Range("E1").Value = wst1.Range("B11").Value　　'納品先
　　　　.Range("F1").Value = wst1.Range("I15").Value　　'発注者
　
　　　　.Range("G1").Value = wst1.Range("A" & i).Value　　'品名
　　　　.Range("H1").Value = wst1.Range("D" & i).Value　　'仕様
　　　　.Range("I1").Value = wst1.Range("G" & i).Value　　'数量
　　　　.Range("J1").Value = wst1.Range("F" & i).Value　　'単位
　　　　.Range("K1").Value = wst1.Range("H" & i).Value　　'備考
　
　　　　.Range("L1").Value = wst1.Range("B14").Value　　'希望納期
　　　　.Range("N1").Value = "FAX"　　'注文方法
　　　　.Range("O1").Value = wst1.Range("A18").Value　　'伝票備考１
　　　　.Range("P1").Value = wst1.Range("A19").Value　　'伝票備考２
　　　End With
　　　newRow = newRow + 1　'つぎの行
　　　No = No + 1　　　　　'◆ この行追加
　　 End If
　Next i
End Sub
【77099】Re:設定済のテーブル内への転記
発言  doro  - 15/5/18(月) 16:42 -
引用なし
パスワード
   ▼kanabun さん：

本当に迅速に対応して頂きありがとうございます！
返信が遅くて申し訳ないです。。。
コードまでありがとうございます、大変見やすくなってますね。
With〜でこんなまとめ方もあるんですね、勉強になりました。

ただ、試してみた結果はDB(wst2)シートのA1:Q2がテーブル設定範囲
(1行目→項目行、2行目→明細はなし･テーブル自動拡張範囲)
なのですが、やはりテーブル外のA3から転記されます…

もう2行目には『test』みたいな行を作っておいて、
別ブックを作るときにもその行だけ残して使用するべきかなあとも考えてますが…
でも、もう少し解決策を求めて、こちらはこのままにさせて頂きます。

コード自体は大変見やすく分かりやすくなったので、頂きます！
ありがとうございました！！
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
982 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free