Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10 Home : Excel 2019)
一覧データからフォーマットへ転記して別のブックに保存する方法
投稿日時: 22/06/03 09:16:15
投稿者: peppe

こんにちは、経理業務をしているVBAまったくの初心者です。
下記テンプレートから抜粋したのですが、
一つ一つデータ作成していかなくてはならず、転記したい項目が多いので
セル=セルでやりたいのですが可能でしょうか?
転記後に"様"をつけたりとかは必要ないのでそのまま一覧から値や文字列をひな型に代入をしたいです。
あと、可能であれば一覧のW列にフラグ「1」をたてて「1」のみ抜粋したデータをから領収書にしたいです。If then でやろうとしたのですが、うまくできませんでした。
いろいろとすみません。どなたかわかる方いらっしゃいましたらお願いします。
 
 
Sub 領収書作成()
Dim wb As Workbook
Set wb = Workbooks.Open(ThisWorkbook.Path & "\領収書ひな型.xlsx")
Dim ws As Worksheet
Set ws = wb.Worksheets(1)
Dim i As Long
For i = 2 To 4
     
    'データの作成
    With Sheet1
        Dim name As String '姓 名
        name = .Cells(i, 1).Value & " " & .Cells(i, 2).Value
 
    End With
     
    'データを転記
    With ws
        .Range("A4").Value = name & " 様"
    End With
     
    'ブックを別名で保存
    Dim wbName As String
    wbName = ThisWorkbook.Path & "\領収書(" & name & ").xlsx"
    wb.SaveAs wbName
Next i
wb.Close
End Sub

回答
投稿日時: 22/06/03 10:56:25
投稿者: QooApp

1.
現在のワークシートのデータの掲載状態も参考までに提供いただけますでしょうか。
VBだけで推し量れない箇所も出てくるのでワークシートのどの座標にどんなデータがあるか知りたいです。
 
VBから読める範囲で勝手に組んでみますが異なると思いますのでこんな感じで掲載いただけますか。
 
ワークシート(Sheet1)
  A   B   C …  W
01 性   名       フラグ?
02 山田  太郎      1
03 山田  二郎
04 山田  三郎      1
05 
 
///////////////////////////////////////////////////////
2.
セル=セルは可能です。
 

ワークシートA.Range("座標").Value = ワークシートB.Range("座標").Value


ワークシートA.Cells(x,y).Value = ワークシートB.Cells(x,y).Value

でセルの中の値のみ転記できます。
Ctrl + ALT + Vで貼り付けメニューから”値のみ貼り付け”をした際の挙動と同義です。
複数のセルの値を結合して挿入する場合、
ワークシートA.Cells(x,y).Value = ワークシートB.Cells(x,y).Value & ワークシートB.Cells(x + 1,y).Value

などで対応できます。
///////////////////////////////////////////////////////
3.
X軸方向(1件=1行)にあるデータをセル=セルで転記したい場合、Y軸に対するFor文の中にX軸に対するFor文を組むことで2方向(縦・横)のデータを処理できますが、転記先の座標が元のワークシートと相対的に全く同じではない場合、If ThenやSelect Case文で例外処理をするか、実際に転記する場合のデータ構造に変換したものをセル=セルで転記することが必要になります。
 
'最も単純な相対コピー(別のワークシートの同じ座標に同じ値を複製する方法)
For y = 2 to 4
 For x = 1 to 23'W列までの場合
  転記先ワークシート.Cells(y,x).Value = 元ワークシート.Cells(y,x).Value
 Next x
Next y

 
'転記先の座標がセルごとに絶対座標で配置が順番ではなく、ぐちゃぐちゃな場合
'前提条件として元ワークシートの1行目各列に転記先ワークシートのどのセルに書き込むか、セル名(1列目はB11とか2列目C4とか)を書き込んで置く。
For y = 3 to 5'←対応させるために1行下げてます注意
 For x = 1 to 22'V列までの場合
  転記先ワークシート.Range(元ワークシート.Cells(1,x).Value).Value = 元ワークシート.Cells(y,x).Value
 Next x
Next y

 
ワークシート(元ワークシート)
  A   B   C …  W
01 B11  C4
02 性   名       フラグ?
03 山田  太郎      1
04 山田  二郎
05 山田  三郎      1
06 
///////////////////////////////////////////////////////
4.
W列をフラグとして利用したい場合以下のような書き方でいかがでしょうか
 
For y = 2 to 4
 If(元ワークシート.Cells(y,23).Value = 1)Then 'またはCells(y,"W").Valueでも動作します
  処理内容
 End If
Next y

この場合、W列の各行が1の場合のみ処理します。
空白以外の何らかの文字が入っている場合に全部処理を行う場合は
If(元ワークシート.Cells(y,23).Value <> "")Then

で良いでしょうか。
///////////////////////////////////////////////////////
最後に
ここまで書いてアレですが、名前の姓名を結合したりする処理を行っているようですので、すべての転記をセル=セルで処理するのは不可能です。その列に対する例外処理が必要です。
 
If Then文やSelect Case文でxがn列目の時のみ、別処理と書いたり、
前述のFor x = 1 to 22部分の開始列・終了列をずらして単純なセル=セルの部分のみ処理し、そこ以外の例外部分は別途自力でコーディングする等の回避が必要です。
 
別のワークシートに実際に転記する値に加工したデータを1行分関数で結合してしまったデータを事前に作っておいてセル=セルで単純処理するなど何パターンか対応方法があります。VBで完結させるとメンテナンス地獄に陥ることもあるので(製作者が行方不明になったプログラムを誰がメンテできるのか?という問題)他に作業できる人がいないなら可能な限り別ワークシート上で転記するフォーマットへ変換したものをセル=セルで転記する方が安全です。
 
例えば1列目と2列目の姓名を半角スペースで結合し、末尾に”様”を結合したデータと、ファイル保存名用に”様”無し版をそれぞれエクセル関数で記述するなど。
 
別ワークシートに以下の記述をセル内に記述してみてください。
●適当なセルに(ここではA3セルあたりでどうか)
=CONCATENATE(OFFSET('元ワークシート'!A1,$B$1-1,0) ," ", OFFSET('元ワークシート'!B1,$B$1-1,0) , "様")
●B1セルに元ワークシートの何行目の案件を参照しているか数字を入力

B1セルに2と入力すると
A3セルに「山田 太郎様」と生成されるはずです。

回答
投稿日時: 22/06/03 11:01:31
投稿者: WinArrow
投稿者のウェブサイトに移動

>転記したい項目が多い
と説明しているわりには、転記項目は1つdけ??
 
それはそれとして
 
一覧表(転記元データ)が
どこにどのような形態で存在するのか・・・・というような説明が必要でしょう
 
>一覧のW列にフラグ「1」をたてて「1」のみ抜粋
条件が明確ならば、フラグを立てる必要もないと思うが・・・・
 
それとも、転記は、VBAでなく手作業でやろうとしているのかな?
 
>うまくできませんでした。
うまいか/まずいかは、他人にはわかりません。
意図した結果と、実行したコードの両方を説明しましょう。
 

回答
投稿日時: 22/06/03 11:05:15
投稿者: QooApp

1つ書き込み忘れてました。
For i = 2 To 4になってますが、2行目から4行目しか作業案件は無いのですか?
 
終了行が不定の場合、「Ctrl + 矢印キーでセルを移動した時にカーソルが停止する位置」という仕様を利用した動的に終了行を算出する処理を入れておいた方がいいかもしれません。
 
現状だと確定で2行目〜4行目=3件の案件しか自動転記されてません。
 
下記URLのサイトで詳細がかかれています。
https://www.niji.or.jp/home/toru/notes/8.html
 
本件の場合は「<S3-1> 上方向に最終行を検索する(改)」
の記述を利用すると終端行を自動で算出できます。
 
MaxRow = Cells(Rows.Count, 1).End(xlUp).Row
↓これを組み込むと
For i = 2 To ワークシート.Cells(Rows.Count, 1).End(xlUp).Row
となる。

投稿日時: 22/06/04 01:01:18
投稿者: peppe

QooApp様 WinArrow様
ご丁寧なご回答ありがとうございます。
質問が雑すぎてすみません、フォーマットをそのまま持ってきてしまったので姓名の結合は必要ありません。
 
もともと管理台帳から納品書を作りたく、列の中には納品書に転記する必要のない項目もございます。
下記転記したいのは、「A〜C,G〜R,W」です。
 
 
  A    B    C    D      E     F        G  〜 R
1 担当者 取引先CD 取引先  契約開始 契約期限  自動延長(〇×)商品1 〜 商品12      
  S    T     U     V      W     X     Y
  区分  商談状況等 納品確認 契約更新年数 納品年月 契約期限 フラグ
 
とりあえず、IF thenはあとで挿入したいと思い。
QooApp様にご教示頂いた
3の転記先座標がぐちゃぐちゃな場合で試してみました。
For i 2to4 はフォーマットをそのまま持ってきてきてしまっていたので
実際には数百件あるので
ご教示頂いた「For i = 2 To ワークシート.Cells(Rows.Count, 1).End(xlUp).Row」を使いたいのですが
そもそもForの使いかたもいまいちわからず、3では「x,y」を使用されていたので
とりあえず1行指定でやってみました。
ws1が元データ、ws2が転記先データです。
 
Sub 納品依頼書作成()
Dim wb1 As Workbook
Dim wb2 As Workbook
Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\納品依頼書.xlsx")
Dim ws1 As Worksheet
Set ws1 = wb1.Sheets(1)
Dim ws2 As Worksheet
Set ws2 = wb2.Sheets(1)
Dim y As Long
Dim x As Long
 
For y = 3 To 3 '←対応させるために1行下げてます注意
  For x = 1 To 24 'X列までの場合
    ws2.Range(ws1.Cells(1, x).Value).Value = ws1.Cells(y, x).Value
  Next x
Next y
     
    'ブックを別名で保存
    Dim wbName As String
    wbName = ThisWorkbook.Path & "\納品書.xlsx"
    wb.SaveAs wbName
wb.Close
End Sub
 
が、Rangeメソッドに失敗しましたとエラーがでてしまいました。
 

回答
投稿日時: 22/06/04 03:39:40
投稿者: QooApp

Rangeメソッドがエラー
 
と表示されたウィンドウに、デバッグ、中断のボタンがあると思うのですが、デバッグボタンを押して黄色のマーカーで線引きされている部分がエラーです。
 
Rangeを使用している箇所は現状1箇所なのでそこだと思いますが、
コピー元ワークシート側の一行目のA列〜最後の列までそれぞれ転記先ワークシートのセル名を定義してますか?
 
記載いただいた表項目のままマクロを起動したならば、一行目に転記先の情報がないのでセル座標とは無関係の文字列がRange()の中に代入されてエラーになったものと考えられます。
 
Range(変数)
 
の、「変数」部分は直接設定する場合、"A1"とか"D1:D5"(これは範囲指定の場合)と書きます。
 
今回は直接設定ではなく、ワークシートの一行目の事前の設定値を参照するような代替処理なのでセル=セルを行う列数分の一行目部分全てに転記先の情報を漏れなくミスなく書かなければなりません。
 
空白だった場合などのエラー対応処理を含めていない単純な処理ですから、逆に正確に間違いなく全て設定しなければなりません。
 
開発するプログラムをブラッシュアップする、という考え方はこのような例外発生時の対応や回避策などを指すものとイメージいただければ良いと思います。
 
今回はとりあえず例外が無く全て準備済み前提の簡便な処理ですので、エラー発生時はデータの準備不足を疑うようにすると早めに対処法が見つかると思います。

回答
投稿日時: 22/06/05 11:44:24
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:

    ws2.Range(ws1.Cells(1, x).Value).Value = ws1.Cells(y, x).Value

このコード実行時
ws1.Cells(1, x).Value
は、セルのアドレス(文字列)でなければ、エラーになります。
 
ステップ実行して、
イミディトインドウで確認してみましょう。

トピックに返信