エクセルの学校：全文検索：Hyper Estraier：表示形式　数値　通貨

Results of 1 - 1 of about 78 for 表示形式　数値　通貨 (0.011 sec.)

表示形式 (6900), 数値 (16331), 通貨 (231)

[[20180331225641]]: #score: 11548; @digest: f573d4945e65918fc965f522e6a873df; @id: 75966; @mdate: 2018-05-15T15:01:21Z; @size: 259502; @type: text/plain; #keywords: 会番 (355784), 積内 (160235), 照会 (159223), 見積 (125866), 積書 (111475), 呼出 (105770), merge (95738), ーー (65196), 取引 (45892), ムコ (42900), 機械 (37182), 名: (27676), 先名 (26413), 引先 (25819), 保存 (22872), 納品 (21986), range (17199), トロ (15600), value (12335), 請求 (11923), 結合 (11914), 単価 (11627), 金額 (11467), 半平 (11357), 数量 (11098), 平太 (11080), 2018 (9135), 、見 (9034), 番号 (8741), function (8286), デー (8148), コン (7672); 『見積書・納品書・請求書の追加作成』（謙児）
お世話になっています。ファイル名:ABC の中に 3つのシートがあります。シート名:各見積書、納品書、請求書です。それぞれ見積書・納品書・請求書の明細が書かれています。私としては、3つの各シート上で見積り書、納品書、請求書の追加データ発行をしたいと思っています。、（追加がある度にファイル名を変えずにファイル名:ABCの中で行いたいのです。）しかし下記の理由によりうまく行きません。何か良いアイデアを教えて頂けませんか? 例えば、A業者からの依頼で、見積書から納品書・請求書迄発行します。支払先名、他、明細内容は、同じです。違うのは、見積り、納品、請求等の依頼文です。従って見積書のデータを主に、納品書の支払先名、明細内容等の各項目データ =見積書の同項目セル番地として見積書と同じデータを表示しています。請求書もしかりです。うまく行かないのは、例えば、 A業者の見積書を作成して相手に送付、返事待ち、その時に、 B業者の依頼で違う見積書を作成しました。当然A業者の納品書は、見積書の各項目データを=で指定していますので、見積書がB業者のデータになる為にA業者の納品書のデータは、B業者の見積書データに変わります。いつもお世話ばかりかけますが、よろしくお願いいたします。＜使用 Excel:Excel2013、使用 OS:Windows10 ＞ ---- EXCEL 見積請求納品の作成方法なんかで検索すればサンプルがたくさんありますよ。やはりデーターは一件につき一行、で処理。が有利かと存じます。表示は工夫次第でおきにいりのレイアウトが可能かと、例得意先コード得意先名日付商品名単価数量金額備考 10001 うどんや 3/1 みかん 100 10 1000 - 10001 うどんや 3/1 うどん 30 100 3000 - 10010 そばや 3/1 そば 50 50 2500 - まと外れでしたらご勘弁を。 m(__)m （隠居じーさん） 2018/04/01(日) 00:13 ---- 質問がよく理解できないけど、なんで1ファイルで全部処理する必要があるんでしょうか伝票[0001_〇〇会社].xls 伝票[0002_××会社].xls ってファイル分けるだけで済むんじゃないでしょうか? もう少しシステムチックに考えるにしても、受注履歴を蓄積するデータベースがあって、印刷したい受注番号を入力や選択すると、データを呼び出してくるみたいなシステムを組むんじゃないかなぁとおもいます（もこな2） 2018/04/01(日) 00:31 ---- 隠居じーさん、お返事有難うございます。〉やはりデーターは一件につき一行、で処理。が有利かと存じます。認識しています。(ただ、一件につき1行で処理をすると、私の作らせて頂いたVBAのエクセル表を後日、他の人に使って頂くときに転記後にシート名、保存先を見るときに横列がながいので、見にくいとおもったので、VBAで最大件数の表示をお願いした次第です。）もこな2様、お返事有難うございます。〉なんで1ファイルで全部処理する必要があるんでしょうか数日前に教えて頂いた、請求書の最大件数の保存転記をそのままいかしています。(連続番号を用いて）おかげさまで請求書の転記が出来ましたから、見積書並びに納品書も別々のシートに転記をしました。一つのファイルにこだわったのは、使う人が、見積書・納品書・請求書の過去からのデータを連続番号を使って残しておきたかったからです。 (勿論、一件のデータ毎に別ファイルをすれば、簡単なことは、よくわかっていますよ。それでは、過去からのデータを連続番号を使って管理するのが、難しいと思ったからです。）〉受注履歴を蓄積するデータベースがあって、印刷したい受注番号を入力や選択すると、〉データを呼び出してくるみたいなシステムを組むんじゃないかなぁとおもいますまさにそういうことをしたかったのです。が思いつかなかったのです。ただ、私が作成している手順は、見積書のフォームに、データを入れます。そのデータを保存先に転記しています。ですから、一件一件のデータを1行毎に入れてから、フォームに入れては、いませんので、受注履歴を蓄積するデータベースを作成して印刷したい受注番号を呼び出してくるには、どのようにしたらいいかアタマが働きません。教えて頂けますでしようか? （謙児） 2018/04/01(日) 06:06 ---- もこな2様頭が働かない中、色々考えた末に、もなこ2様がおっしゃった見積書・納品書・請求書を追加で作成の場合には、ファイル名を変えて保存するようにします。その時に、連続番号でデータを管理するファイルを別に作ろうと思います。ファイル名:データ管理シート名:保存ここから質問です。以前に教わり解決しましたVBAのコードの中で、別ファイルの、ファイル名:データ管理シート名:保存に転記するためには、下記コードのどこをどのように直せば宜しいかお伺いします。なお、元の見積書等のファイル名は、追加があれば名前を付けて保存になりますので、ファイル名が追加毎に任意で変わります。ファイル名が変わっても、ファイル名:データ管理シート名:保存に転記されるようなコードを教えて頂けますでしょうか? （さっきネットでブックを開くには、WorkbooksコレクションのOpenメソッドを使います。を検索をして、 Workbooks.Open Filename:="C:¥データ管理.xlsx"に替えたてエラーが出てやり直したりしましたがうまく起動しません。）下記コードは、以前に教えて頂いた、解決しましたコードです。 Option Explicit Sub てすと() Dim MyTbl As Range Dim MyA As Variant Dim MyAry() As Variant Dim 連番() As Variant Dim 最大行 As Long Dim i As Long Dim j As Long Dim k As Long Dim x As Variant Dim MyFlg As Boolean Dim 判定 As Boolean With Sheets("請求書") If .UsedRange.Rows.Count = 1 Then MsgBox "請求書にデータがありません。" & vbCrLf & vbCrLf & _ "請求書にデータを入力してから実行してください。" Exit Sub End If MyA = Intersect(.Range("b:av"), .UsedRange, .Rows("91:116")).Value Set MyTbl = .Range("b91:av116") End With For i = LBound(MyA, 1) To UBound(MyA, 1) For j = LBound(MyA, 2) To UBound(MyA, 2) If MyA(i, j) <> "" Then MyFlg = True Next Next If MyFlg = False Then MsgBox "請求書に転記するデータがありません。" & vbCrLf & vbCrLf & _ "請求書に転記するデータを入力してから実行してください。" Set MyTbl = Nothing Erase MyA Exit Sub End If If Application.CountA(MyTbl) = 0 Then MsgBox "請求の " & MyTbl.Address(0, 0) & " に、データがありません。" & vbCrLf & vbCrLf & _ "請求書の " & MyTbl.Address(0, 0) & " にデータを入力してから実行してください。" Set MyTbl = Nothing Erase MyA Exit Sub End If 'データ91行から107行目一部にに空白が出来たら '転記の際にその行は詰めて表示されますように教えて頂けないでしょうか? With Sheets("請求書") For i = LBound(MyA, 1) To 17 判定 = False For j = LBound(MyA, 2) To UBound(MyA, 2) If MyA(i, j) <> "" Then 判定 = True MsgBox .Cells(90 + i, j + 1).Address(0, 0) & " には、" & vbCrLf & vbCrLf & _ MyA(i, j) & vbCrLf & vbCrLf & _ "がありますので取り敢えず転記します。" Exit For End If Next If 判定 Then k = k + 1 ReDim Preserve MyAry(LBound(MyA, 2) To UBound(MyA, 2), 1 To k) For j = LBound(MyA, 2) To UBound(MyA, 2) MyAry(j, k) = MyA(i, j) Next Else MsgBox 90 + i & " 行には、" & vbCrLf & vbCrLf & _ "転記する物がありませんのでパスします。" End If Next End With '108行から116行迄は、合計金額等のデータで必ず入ります。 ReDim Preserve MyAry(LBound(MyAry, 1) To UBound(MyAry, 1), LBound(MyAry, 2) To UBound(MyAry, 2) + 9) For i = 18 To UBound(MyA, 1) k = k + 1 For j = LBound(MyA, 2) To UBound(MyA, 2) MyAry(j, k) = MyA(i, j) Next Next k = 0 Application.ScreenUpdating = False With Sheets("保存先") 最大行 = .UsedRange.Rows.Count ReDim 連番(1 To 最大行 + 1) If 最大行 < 2 Then 最大行 = 最大行 + 1 .Cells.Clear .Rows(1).Value = Sheets("タイトル").Rows(1).Value k = k + 1 連番(1) = Format(k, "0# 番") Else k = 1 連番(1) = Format(k, "0# 番") 最大行 = 最大行 + 2 For i = 2 To 最大行 - 1 If Application.CountA(.Rows(i)) = 0 Then k = k + 1 連番(i) = Format(k, "0# 番") End If Next End If .Range("B" & 最大行).Resize(UBound(MyAry, 2), UBound(MyAry, 1)).Value = Application.Transpose(MyAry) .Range("A2").Resize(UBound(連番)).Value = Application.Transpose(連番) End With Application.ScreenUpdating = True Set MyTbl = Nothing Erase MyA, MyAry, 連番 MsgBox "請求書のデータを保存先 " & Format(k, "0# 番") & " に保存しました。" End Sub （SoulMan） 2018/03/28(水) 21:18 以上ですが、よろしくお願いいたします。（謙児） 2018/04/01(日) 10:11 ---- こう云うのは、所謂システムと呼ばれるものなんです。当初の質問時にワンレコードを1行で管理し、見たり、印刷したりしたい時、そこから呼び出すようにすべし、とのアドバイスがありましたよね? そのアイデアを捨て進めてしまい、現在に至って頓挫している、と言う状況ですよね? (今の保存方式でも出来なくは無いですが、苦労が増えるだけです）システムと呼ばれるものは、「新規追加・保存」「呼出・修正・保存」「削除」の基本機能が必要になります。これをどうストレス少なく処理できるかがポイントです。 ※なお「削除」は危険過ぎるので、ここでは考えません。そちらのご説明では、見積書さえ作れば、、納品書、請求書は自動的に出来上がる様なので、見積書を軸足にして処理すればいいと思います。ーーーーーーーーーーーー A会社の見積書を作る→印刷する→1行保存をする (A会社の返事待ち中にB会社の見積もりが必要になった） B会社の見積書を作る→印刷する→追加的1行保存をする (A会社の返事が来た) 保存したデータを呼び出して見積書を再構成する。すると数式により納品書が自動的に出来上がる →納品書を印刷する ※できれば、納品書作成段階まで進んだ旨のデータを追加して上書き保存するーーーーーーーーーーーーー修正したい時も同様に、見積書を再構成してから、修正・保存を行えばよし。ーーーーーーーーーーーーー懸案事項として 1.見積書のフォーム(様式）は十分に固まっているか。様式変更は面倒な問題を惹起します。どれだけ、将来の様式変更に対応できるように作る必要があるか、見極める必要があります。「絶対に変更ない」との前提でよければ凄く楽になります。 2.保存データを呼び出す手掛かり(キーと呼ばれるもの）をどう構成するか。会社名だけでは、何件もあるデータの中から特定することは出来ない。通常は、会社名+見積日付が最短キーになるかと思いますが、果たしてそれでいいのかどうか。機械処理的には、見積書NO(ダブりがないもの）をキーにする方がいいのですけども・・因みに、現在の方式では、どんな方法でマクロを実行させているんですか? どこかに実行ボタンが作ってあって、それをクリックする方式? もしその方式なら、呼び出しボタンも一つ追加する必要があります。（半平太） 2018/04/01(日) 10:28 ---- 半平太様、おはようございます。システムの基本を色々教えて頂き有難うございます。〉そのアイデアを捨て進めてしまい、現在に至って頓挫している、と言う状況ですよね? もうとう捨てる気はないのですが、時間が時間がたってもお返事がないので、私が具体的に示さないためかなあと思って別途ファイルを作り…と考案しました。〉A会社の見積書を作る→印刷する→1行保存をするの何行かは、私が望んでいることです。懸案事項、落ち着いて精査してみます。〉因みに、現在の方式では、どんな方法でマクロを実行させているのですか? いまは、コードを出して実行しています、勿論、他の人に使って頂くときには、ボタンを使用します。回答者の方に2度手間をかけないように、仕事の合間をぬって少し考えます。有難うございました。また連絡します。（謙児） 2018/04/01(日) 11:22 ---- ＞受注履歴を蓄積するデータベースを作成して印刷したい受注番号を呼び出してくるには、どのようにしたらいいかアタマが働きません。今回のご質問のことってVBAつかってやることでもないとおもうんですよね ↓を適当なブック（新規ブック）を用意して標準モジュールに張り付けて実行してみてください Sub 説明データ生成() Dim i As Integer With ThisWorkbook.Worksheets.Add .Name = "DB" With .Range("A1") .Value = "0001-1" .AutoFill Destination:=.Resize(5) .Offset(, 1).Resize(5, 4).Value = "あああ" End With With .Range("A6") .Value = "0002-1" .AutoFill Destination:=.Resize(3) .Offset(, 1).Resize(3, 4).Value = "いいい" End With With .Range("A9") .Value = "0003-1" .AutoFill Destination:=.Resize(6) .Offset(, 1).Resize(6, 4).Value = "ううう" End With End With With ThisWorkbook.Worksheets.Add .Name = "テスト" With .Range("A1") .Value = "入力→" .Offset(, 1).NumberFormatLocal = "@" End With With .Range("A3") .Value = 1 .AutoFill Destination:=.Resize(8), Type:=xlFillSeries End With With .Range("B3") For i = 2 To 5 With .Offset(, i - 2) .Formula = "=IFERROR(VLOOKUP($B$1&""-""&$A3,DB!$A:$E," & i & ",0),"""")" .AutoFill Destination:=.Resize(8) End With Next i End With End With End Sub つぎに「テスト」シートの「B1」セルに0001、0002、0003 ってそれぞれ入力してみて動きを確認してみてください。（もこな2） 2018/04/01(日) 11:25 ---- 失礼。数式の部分は、こちらのほうがいいですね。 .Formula = "=IFERROR(IF(VLOOKUP($B$1&""-""&$A3,DB!$A:$E," & i _ & ",0)=0,"""",VLOOKUP($B$1&""-""&$A3,DB!$A:$E," & i _ & ",0)),"""")" （もこな2） 2018/04/01(日) 11:53 ---- 実例がないと考えにくいので、以下のサンプルで、たたき台を作ってみます。 <見積書> 行 ___A___ ____B____ _______C_______ __D__ __E__ ___F___ 1 見積書 2 顧客No お客様名 3 10001 うどんや日付 3月1日 4 5 商品名摘要単価数量金額 6 なべ焼き 100 10 1,000 7 たぬき 30 7 210 8 9 10 備考配達は午前中 11 先日の器を回収すると、保存に必要なデータは A3:B3,B6:E7,C10:C$11 の範囲と言うことになります。(数式が入っているところは非対象) その範囲を(Ctrlキーを押しながら）全部選択して、名前ボックスに「保存範囲」とでも命名するものとします。 1.保存シートにあらかじめタイトルを書き出します。下記マクロ（タイトルとアドレス書出）を使って、一回だけ実行します。 ※このマクロは、様式に変更が無い限り、これで用済みです。 <保存>シートはこんなタイトルになります。(2行書き) 行 _A_ ______B______ ____C____ __D__ ___E___ __F__ __G__ __H__ 1 A3 B3 B6 C6 D6 E6 B7 2 KEY 得意先コード得意先名日付商品名単価数量金額 2.次からが日常処理です。（1）顧客Aから新規オーダーが入ったので見積書を作成する。（もし前回の取引先のデータが残っている場合は「保存範囲」を選択してクリアする。）冒頭で想定したデータを入力して、印刷したら、「保存」ボタンをクリックする。 ↓ 「保存」マクロが実行される。 <保存結果図> 行 _______A_______ ______B______ ____C____ ____D____ ___E___ __F__ __G__ ___H___ _I_ _J_ _K_ _____ L _____ 1 A3 B3 B6 C6 D6 E6 B7 C7 D7 E7 C10 ・・・ 2 KEY 得意先コード得意先名日付商品名単価数量金額 3 10001-20180301 10001 うどんやなべ焼き 100 10 たぬき 30 7 配達は午前中・・・（2）顧客Bから新規オーダーが入ったので見積書を作成する。（前回の顧客Aのデータが残っている場合は「保存範囲」を選択してクリアする。）下図の様なデータを入れて、印刷してから「保存」ボタンをクリックする。 <見積書入力図> 行 ___A___ ____B____ _____C_____ __D__ __E__ ___F___ 1 見積書 2 顧客No お客様名 3 10010 そばや日付 3月2日 4 5 商品名摘要単価数量金額 6 かけ 123 11 1,353 7 もり 345 5 1,725 8 9 10 備考配達は夕方 <保存結果図> 行 _______A_______ ______B______ ____C____ ____D____ ___E___ __F__ __G__ ___H___ _I_ _J_ _K_ ______L______ 1 A3 B3 B6 C6 D6 E6 B7 C7 D7 E7 C10 2 KEY 得意先コード得意先名日付商品名単価数量金額 3 10001-20180301 10001 うどんやなべ焼き 100 10 たぬき 30 7 配達は午前中 4 10010-20180302 10010 そばやかけ 123 11 もり 345 5 配達は夕方（3）顧客Aから見積りが間違っているとか、納品してくれとか言われた「履歴呼出」ボタンをクリックして訊かれた「キー」(例10001-20180301）を入力し、元データを呼び出し、見積書を再現する (a)見積もりの修正なら、所要データを修正して、見積書を再印刷後、「保存」ボタンをクリックする。（b）納品書作成なら納品書シートに云って、納品書を印刷する。ーーーーーーーーーーーーーーーーーーーーーーーー関連マクロ(ちょっと荒っぽく作ってあります。) ↓ Option Explicit Dim rngToStore As Range Dim WshSRC As Worksheet Dim WshDST As Worksheet Private Sub 初期値取得() Set WshSRC = Sheets("見積書") Set WshDST = Sheets("保存") Set rngToStore = WshSRC.Range("保存範囲") End Sub Sub タイトルとアドレス書出() '一回実行すればよし Dim cel As Range Dim COL As Long Call 初期値取得 WshDST.Cells(2, 1).Resize(1, 8).Value = [{"KEY","得意先コード","得意先名","日付","商品名","単価","数量","金額"}] COL = 1 For Each cel In rngToStore COL = COL + 1 WshDST.Cells(1, COL).Value = cel.Address(0, 0) Next End Sub Sub 履歴呼出() Dim KEY Dim Rw Dim cel As Range Call 初期値取得 KEY = InputBox("KEY 例(10001-20180301") Rw = RwNum(KEY) If Not IsNumeric(Rw) Then MsgBox "当該KEYは存在しません" Exit Sub End If For Each cel In WshDST.Range("B1", WshDST.Cells(1, 1000).End(xlToLeft)) WshSRC.Range(cel.Value) = WshDST.Cells(Rw, cel.Column).Value Next End Sub Private Function RwNum(ByVal KEY) As Variant Call 初期値取得 RwNum = Application.Match(KEY, WshDST.Columns(1), 0) End Function Sub 保存() Dim cel As Range Dim COL As Long Dim KEY As Variant Dim Rw As Variant Dim msg As String Call 初期値取得 KEY = WshSRC.Range("A3") & Application.Text(WshSRC.Range("F3").Value2, "-yyyymmdd") Rw = RwNum(KEY) If IsNumeric(Rw) Then '上書き保存 msg = "上書き保存しました" Else '新規 msg = "新規保存しました" Rw = WshDST.Cells(WshDST.Rows.Count, "A").End(xlUp).Row + 1 End If WshDST.Cells(Rw, 1) = KEY COL = 1 For Each cel In rngToStore COL = COL + 1 WshDST.Cells(Rw, COL).Value = cel.Value Next MsgBox msg End Sub （半平太） 2018/04/01(日) 14:07 ---- ども^^ 横入り失礼します。＞うまく行かないのは、例えば、＞A業者の見積書を作成して相手に送付、返事待ち、その時に、＞B業者の依頼で違う見積書を作成しました。＞当然A業者の納品書は、見積書の各項目データを=で指定していますので、＞見積書がB業者のデータになる為にA業者の納品書のデータは、B業者の＞見積書データに変わります。マクロとデータを別のファイルで管理したほうがよさそうに思えます。マクロのあるファイルから、各見積書ファイルを開いて操作すればよいです。各ファイルの元の雛型ファイルは、テンプレート形式で保存しておきます。テンプレートファイルというのは開くたびにコピーが新しく開きます。保存は新規で保存しますので、上書きはされません。名前を同じだと上書きになりますが。そうすることで、入力するたびに前前回のものが残ってないということは避けられます。出来れば、それを発展させて、1件1行に集積していけばさらに良いのは他の方の説明の通りです。なにより1件1行というのはエクセルが想定している型なので、そうすることでエクセルの様々な機能を利用できます。すでにある機能を利用できるということは自分で開発する必要がないということです。つまり、今ある機能を再利用することで開発が簡素で容易になる利点あります。独自の様式で全部自分で開発するなら、いかようにでもなるでしょうが、複雑になり開発に時間がかかるのでお勧めではありません。 1行一件というのは見積書1枚ではなく各個々のデータです。 1枚の見積書は見積書番号で管理すればよいでしょう。そうすることで、見積書の雛型に見積書が再現できるようになります。マクロを使えば、瞬時に再現させられるので、見積書1枚1枚毎に保存する必要がなくなりますが、まずは1枚1枚をファイルにしてそれを管理するところからマクロに慣れてはいかがでしょうか? 今までは、自ブックというのをなんとなく意識しなかったでしょうが、どのブックかという記述を追加するだけで、改変はそんなにはないと思います。（まっつわん） 2018/04/01(日) 14:50 ---- もこな様お返事おそくなりすみません。（今、落ち着きましたので、もこな様にアップしようとしましたら、半平太さまからとまっつあん様から、たくさんのコメント（実例を含み）を有難うございます。今から見させて頂き実行していきます。）もこな様の上記コードを実行し動きはわかりました。ルックアップを利用してこのような事が出来る、素晴らしいと思いました。＞受注履歴を蓄積するデータベースがあって、印刷したい受注番号を入力や選択すると、＞データを呼び出してくるみたいなシステムを組むんじゃないかなぁとおもいますこの考え方は、各項目のデータを1行に入力した後で、見積書のフォームに組み込むという流れでしょうか? そうであれば、下記のコードのように印刷するデータ範囲をコードの中にいちいち入れないと行けないのでしょうか? それよりも印刷する見積書の各項目にどうやって転記されるのでしょうか? よろしくお願いいたします。 With .Range("A6") .Value = "0002-1" .AutoFill Destination:=.Resize(3) .Offset(, 1).Resize(3, 4).Value = "いいい" End With （謙治） 2018/04/01(日) 19:10 ---- えーっと・・・＞もこな様の上記コードを実行し動きはわかりました。伝え方がわるかったんですかね・・・・わたしとしては、＞＞つぎに「テスト」シートの「B1」セルに0001、0002、0003 ってそれぞれ入力してみて動きを確認してみてください。 ↑の意味って＞＞今回のご質問のことってVBAつかってやることでもないとおもうんですよねってお話したとおり、データベースから引っ張ってくるくらいのことはVBA使わなくてもできますよね?って言いたくて、例を提示しただけのつもりなんですが。。。まぁコードの動きがわかったのであれば、今回のご質問とは関係ないということもわかると思うんですっぱり忘れてください。とりあえず、いろんな人からのアドバイスを全部やろうとするとこんがらがってしまうので、どのアイデアを採用するのかを自分できちっときめて、そのうえで分からない部分を聞くようにしたらいいんじゃないでしょうか? 現状だと、まったくわからないのでアイデア募集 ↓ 複数のアイデアが寄せられる ↓ すべてのアイデアをごちゃまぜにしてわからなくなる ←いまココのように思います。（もこな2） 2018/04/01(日) 19:49 ---- もこな2様＞データベースから引っ張ってくるくらいのことはVBA使わなくてもできますよね?って言いたくて、例を提＞示しただけのつもりなんですが。。。そういう意味だったのですね。勘違いしていました。本当にすみませんでした。＞とりあえず、いろんな人からのアドバイスを全部やろうとするとこんがらがってしまうので、どのアイデア＞を採用するのかを自分できちっときめて、そのうえで分からない部分を聞くようにしたらいいんじゃないで＞しょうか? ＞すべてのアイデアをごちゃまぜにしてわからなくなる ←いまココ＞のように思います。その通りです。コメント、有難うございます。私は、今回だけでなく、いつも各回答者が時間をさいて一生懸命に説明しておられるのに、ある回答者の説明がわかりやすいと思ってその人にだけ進んで行くのは、他の人に対して失礼といつも思っています。（でも言われるように私がいろいろな回答者から説明を受けてそれぞれ理解できる能力であれば問題ないと思いますが、そうでありませんから。）でもこれで思い切って今後、複数の回答者から説明を受けても、どのアイデアを採用するかを自分で決めていきます。もこな2様以外の回答者の皆様も採用できない場合には、失礼と思いますがお許しください。半平太様のVBA明日午後から始めます。有難うございます。（謙治） 2018/04/01(日) 21:51 ---- 半平太様今晩は、遅くなってすみません。たたき台を作って頂き、且つ順番に説明を頂き有難うございました。私も半平太様のようにうまく出来ませんでしたが、具体的に、実際のデータを下記のように作成しました。アルファベットの文字は、列を表します。 xxからxx と記載しているのは、セルを結合したものです。列幅は、10以下の為たくさんの列があります。 VBAの保存を実行するとうまく行きません。下記は、"新規保存しました"のまとめですが、見積書の最初にあるデータ、住所・名前が3行目のかなり左の列に表示されています。?? セル幅が10以下で余白が出来ているためにずれていくのでしょうか? 私も明日、時間を見つけて確認をしてみます。ご指導お願いします。 a列 b列 c列 d e f g h ----- 1行 AC5 AC6 B7 B8 B9 B10 B11 ----- 2行 KEY 照会番号発行日〒住所1 住所2 相手先名1 相手先名2 ----- 3行 -19000100 B30 Y30 AC30 AE30 B31 Y31 AC31 AE31 B32 Y32 AC32 AE32 見積内訳単価数量金額見積内訳単価数量金額見積内訳単価数量金額東京都新宿区新宿第一ビル＞Sub タイトルとアドレス書出() '一回実行すればよし Dim cel As Range Dim COL As Long Call 初期値取得 WshDST.Cells(2, 1).Resize(1, 18).Value = [{"KEY"、"照会番号"、"発行日"、"相手先名等"、"見積金額"、"納期"、"有効期限"、"支払い条件"、"見積内訳"、"単価"、"数量"、"金額"、"金額合計"、"割引"、"小計"、"消費税"、"見積合計金額"、"備考" }] COL = 1 For Each cel In rngToStore COL = COL + 1 WshDST.Cells(1, COL).Value = cel.Address(0, 0) Next End Sub 下記は、実際の表です。 yからab（結合）acからaj（結合）照会番号 1234568 発行日 2018/4/1 b c d ef g h i 7 〒XXX-XXXX 8 東京都新宿区 9 新宿第一ビル 10 〇〇〇〇〇株式会社御中 11 △△△様 bから f（結合） g h i j k l m 18 お見積金額 2,035 （g18からm19セルの結合） 19（b18からf19セルの結合） (b) (gからm結合） 21 納期 2018/4/15 22 有効期限 2018/5/30 23 支払い条件納入月締め、翌月末振込（←納入月末締め、翌月末振込セルは、縮小をしています。）（半平太様へ、26行目は、見出しです。） b から x y からab acからad aeからai 26 見積内訳単価数量金額 27 XX機械 1,500,000 4 6,000,000 28 グレーチング 500,000 8 4,000,000 29 鋳物 600,000 15 9,000,000 30 電気ドリル 200,000 1 200,000 31 32 33 34 35 36 37 38 39 40 41 42 43 y からab ae から ai 44 数量、金額合計 19,250,000 45 割引 -1,925000 46 小計 17,325,000 47 消費税 1,386,000 48 見積金額合計 18,711,000 49備考 EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE 50 DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD （謙治） 2018/04/02(月) 21:59 ---- そちらの記述から実物をキッチリ再現するのはちょっと大変なので、先ずは、こちらの予備知識を補強する為、見積表シートのデータ範囲（※）を教えて下さい。（※）以下のマクロを実行するとメッセージに表示される範囲のことです。 Sub getUsedRangeAdr() MsgBox Sheets("見積書").UsedRange.Address(0, 0) End Sub （半平太） 2018/04/02(月) 23:05 ---- 半平太さま明日、会社に行ってから上記マクロを確認します。有難うございました。（謙児） 2018/04/02(月) 23:27 ---- 半平太様こんにちは、先ほど会社に付きました。＞Sub getUsedRangeAdr() ＞ MsgBox Sheets("見積書").UsedRange.Address(0, 0) ＞ End Sub >見積表シートのデータ範囲（※）を教えて下さい。範囲は、b1:ai52 です。よろしくお願いいたします。このMsgBox、便利ですね。（最後の列ai52は、当初ajでしたが照会番号と発行日のみが結合していましたので、結合しなおしaiにしました。）半平太様がこれから補強に入られる為、私が誤りか誤りでないかわかりませんが、半平太様にお伝えしないと時間をかけていただくにとどまるかわかりませんので、下記にお伝えします。 1、＞数式が入っているところは非対象) その範囲を(Ctrlキーを押しながら）全部選択して、＞名前ボックスに「保存範囲」とでも命名するものとします。言われるように範囲を指定しました。名前ボックスは、「保存範囲」。 2、見積書のデータは、別のシート名:フォームコントロール（フォームコントロールのボタン、及び、コントロールの書式設定でリンクするセル等を選びます。）等で選ぶようにしています。したがって見積書の各データ項目は、例えば、照会番号を入力するAC5には、=フォームコントロール!AC5 を入れています。 3、＞下記、マクロは、1回目だけという事で＞Sub タイトルとアドレス書出() '一回実行すればよし .Value = [{"KEY"、"照会番号"、----でコントロールで範囲を決めた順に照会番号、発行日 etcを記載しまして保存を実行しましたが、貼付順番がバラバラの為に、範囲の選定に誤りがあるかと思い範囲の指定を変えるとともに、コードで名称を最初から変えていくのが面倒なために、シート名:保存の1行目と2行目は、自分でセル番地と項目名を手入力しました。ただ、範囲の設定の中で、順番がわからないのは、見積内訳のB27からB43迄選択、次に単価 Y27行目から43行目まで選択、次に数量AC27行目から43行目迄選択、次に金額AE27行目からAE43行目を選択の順番でいいのでしょうか? それとも範囲の順番は、見積内訳のB27、次に単価のY27、数量のAC27、金額のAE27、次に見積内訳のB28、単価のY28、数量のAC27、金額のAE28 のように横列に進み次の行にいき見積内訳から金額迄行ってまた次の行と繰り返していく方法が良いのでしょうか私は、後者の方を取り入れました。見積内訳の列は、B27からX27までです。が、名前ボックスの保存範囲は、B列だけです。（ここが、セルの結合をしなければならないかがわかりません。）以上ですが、なかなか思ったことを文章化出来ません。ご配慮のほど、よろしくお願いいたします。数量の金額もそれぞれ27行目から43行目見積内訳の行を順番に下の行にまず見積内訳ですが、見積内訳は、B27から下にB43迄の範囲を選択、次に単価は、Y27からY43迄の範囲を選択、数量は、AC27からAC43迄の範囲を選択、金額は、AE27からAE43までの範囲を選択となります。 A列 B列 C列 D列 AC5 AC6 B7 KEY 照会番号発行日〒 -19000100 WshDST.Cells(2, 1).Resize(1, 18).Value = [{"KEY"、"照会番号"、"発行日"、"相手先名等"、 "見積金額"、"納期"、"有効期限"、"支払い条件"、"見積内訳"、"単価"、"数量"、"金額"、 "金額合計"、"割引"、"小計"、"消費税"、"見積合計金額"、"備考" }] COL = 1 For Each cel In rngToStore COL = COL + 1 WshDST.Cells(1, COL).Value = cel.Address(0, 0) Next End Sub （謙治） 2018/04/03(火) 15:14 ---- ＞半平太さま自分から言うのもなんですが・・長引くかも知れないので、以後「さん」付けでお願いします。「さま」は私には重すぎます。＞範囲は、b1:ai52 です。 A1セルからじゃないんですか・・、ちょっと不思議。しかも見積書としては、尋常じゃなく広範囲ですね。結合セルが多いセイなんですかねぇ。＞yからab（結合）acからaj（結合）＞照会番号 1234568 ＞発行日 2018/4/1 Q1. その「照会番号」をキーとしていいんでしょうか?（本当に存在するデータなのですか?） ※キーとは、重複が無く、それだけで他の取引と区別できるデータ＞貼付順番がバラバラの為に、範囲の選定に誤りがあるかと＞思い範囲の指定を変えるとともに、貼り付け順序をどうするかはマクロに任せます。人間が見るものでもないので・・・・と言っても見に行っちゃうのが人情でしょうね。人間が見に行った時、人間が分かり易い順序である方がいいに決まっていますが、余りこだわると本質を見失います。保存シートはあくまで機械が処理する為にデータを格納している倉庫に過ぎません。機械が間違いなく情報の出し入れができるなら、最低条件は満たされています。＞シート名:保存の1行目と2行目は、自分でセル番地と項目名を手入力しました。機械にとっては1行目が重要で、2行目は何の意味もないです。（A2に「KEY」が入っていることだけは処理上、意味があります） 1行目に書かれるセルアドレスを見て見積書の再現を正しく行うことが出来ることになります。＞見積内訳の列は、B27からX27までです。が、名前ボックスの保存範囲は、B列だけです。 Q2. ここの部分がちょっと分からないです。上の方で、AC5とかAC6とかあったと思うんですけど、そこをご自分で書いたのですか?（機械に任せないと食い違いが起きます） B列だけが保存範囲なら「B○」にしかならないハズです。 ↓ ＞1行 AC5 AC6 B7 B8 B9 B10 B11 ----- ＞2行 KEY 照会番号発行日〒住所1 住所2 相手先名1 相手先名2 ----- ＞3行 -19000100 ＞B30 Y30 AC30 AE30 B31 Y31 AC31 AE31 B32 Y32 AC32 AE32 ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー見積書シートをこちらで再現するため、以下の方法を使います。そちらの作業 1.現物ファイルのコピーを作成する（このブックをお互いの共通認識ブックに仕立て、話に食い違いをなくさせる） 2.見積書シート上の重要情報は、無難なものに書き換える（消去はしないでください。手掛かりが無くなっちゃいます） 3.長い文字列は簡単な表現に換える 4.上記準備が整ったら、後記の「見積書再現プログラム作成」マクロを実行してください。下記<プログラム実行手順>をご参照 5.上記4の結果、所期のプログラムコードが作成され、それがクリップボードに自動的に記憶されます。その状態をキープしたまま（つまり、何か余計なことをやらないで）、この掲示板の「コメント返信」ボックス内を右クリックして、貼り付ける。 6.コードの中に重要情報が書き出されていないことを再確認してからアップする。万一、存在していたら、上記2からやり直してください。当方は、アップされたプログラムコードを実行して、そちらと同じ見積書シートを再現します。 <プログラム実行手順> 見積書シートの「シート見出し」を右クリックして、「コードの表示(V)」を選ぶ。すると、画面中央に白いエリアが出ます。(VBE画面と呼ばれています。) そこに後記マクロコードを貼り付けてください。貼付けたら、F5キーを押下する（→「見積書再現プログラム作成」マクロが実行される） 'シートモジュールに貼り付けるべきマクロコードここから --------------- Public Sub con再現プログラム作成() Const modelMRG As String = " Range(""Adrs"").Merge" Const modelCLR As String = " Range(""Adrs"").Interior.ColorIndex = " Const modelVAL2 As String = " Range(""Adrs"").Value = " Const modelFML As String = " Range(""Adrs"").FormulaR1C1Local = " Const modelFMT As String = " Range(""Adrs"").NumberFormatLocal = ""@""" '文字列(頭が「'」のデータ処理 Const modelFME As String = " Range(""Adrs"").NumberFormatLocal = " '標準外の表示形式 Dim WSF As WorksheetFunction Dim rslt Dim dataToFil Dim cel As Range Dim Codes As String Dim NN As Long, PP As Long Dim BlocksToRight As Long, BlocksToBottom Dim rngSelected As Range Set rngSelected = Me.UsedRange Set WSF = WorksheetFunction On Error Resume Next ThisWorkbook.Sheets("出力Wsh").Range("A1").Value = Empty 'シート存在テスト If Err.Number <> 0 Then ThisWorkbook.Sheets.Add.Name = "出力Wsh" End If On Error GoTo 0 NN = 0 With ThisWorkbook.Sheets("出力Wsh") NN = NN + 1: .Cells(NN, 1).Value = "Private Sub onlyOnce()" NN = NN + 1: .Cells(NN, 1).Value = "Rem ' Range(""" & rngSelected.Address(, , , True) & """).Clear" NN = NN + 1: .Cells(NN, 1).Value = Empty NN = NN + 1: .Cells(NN, 1).Value = " Rem 結合状態を処理" For Each cel In rngSelected '結合状態を処理---------------- With cel If .MergeCells Then '結合状態になっているセルを処理 If .MergeArea.Item(1).Address = .Address Then NN = NN + 1 dataToFil = Replace(modelMRG, "Adrs", .MergeArea.Cells.Address(0, 0)) ThisWorkbook.Sheets("出力Wsh").Cells(NN, 1).Value = dataToFil End If End If End With Next NN = NN + 1: .Cells(NN, 1).Value = Empty NN = NN + 1: .Cells(NN, 1).Value = " Rem 数式セル以外をまとめて処理" rslt = sameKindS(rngSelected, modelVAL2, "値") For PP = LBound(rslt) To UBound(rslt) If rslt(PP) <> Empty Then ' NN = NN + 1: .Cells(NN, 1).Value = rslt(PP) rslt(PP) = Replace(rslt(PP), vbLf, """ & Chr(10) & """) NN = NN + 1: .Cells(NN, 1).Value = rslt(PP) End If Next PP NN = NN + 1: .Cells(NN, 1).Value = Empty NN = NN + 1: .Cells(NN, 1).Value = " Rem 数式セルをまとめて処理" rslt = sameKindS(rngSelected, modelFML, "数式") For PP = LBound(rslt) To UBound(rslt) If rslt(PP) <> Empty Then NN = NN + 1: .Cells(NN, 1).Value = rslt(PP) End If Next PP NN = NN + 1: .Cells(NN, 1).Value = Empty NN = NN + 1: .Cells(NN, 1).Value = " Rem 標準外書式セルをまとめて処理" rslt = sameKindS(rngSelected, modelFME, "セル書式") For PP = LBound(rslt) To UBound(rslt) If rslt(PP) <> Empty Then NN = NN + 1: .Cells(NN, 1).Value = rslt(PP) End If Next PP NN = NN + 1: .Cells(NN, 1).Value = Empty NN = NN + 1: .Cells(NN, 1).Value = " Rem 塗りつぶしセルをまとめて処理" rslt = sameKindS(rngSelected, modelCLR, "塗りつぶし") For PP = LBound(rslt) To UBound(rslt) If rslt(PP) <> Empty Then NN = NN + 1: .Cells(NN, 1).Value = rslt(PP) End If Next PP NN = NN + 1: .Cells(NN, 1).Value = "End Sub" .Range("A1").Resize(NN, 1).Copy End With End Sub Private Function sameKindS(rng As Range, modelFMS, Optional aim As String = "値") '一般形 Dim dic As Object Dim cel As Range Dim Adrs As String Dim AdrsBreak Dim sNum As String Dim eachKey Dim NN As Long Dim dataToFil Dim ItemVal Set dic = CreateObject("Scripting.Dictionary") ' 連想配列の定義 For Each cel In rng ItemVal = Empty Select Case aim Case "値" If Not cel.HasFormula And Not IsEmpty(cel.Value) Then ItemVal = IIf(IsError(cel.Value2), cel.Formula, cel.Value2) End If Case "数式" If cel.HasFormula Then ItemVal = cel.FormulaR1C1Local End If Case "セル書式" If cel.NumberFormatLocal <> "G/標準" And _ TypeName(cel.Value) <> "Currency" Then '標準外の書式を反映させる。通貨型は面倒なので処理外 ItemVal = cel.NumberFormatLocal End If Case "塗りつぶし" If cel.Interior.ColorIndex <> -4142 Then '塗りつぶしがあるセルを処理 ItemVal = cel.Interior.ColorIndex End If End Select If Not IsEmpty(ItemVal) Then If dic.Exists(ItemVal) Then AdrsBreak = Split(dic(ItemVal), "#") sNum = AdrsBreak(0) + 1 dic(ItemVal) = sNum & "#" & AdrsBreak(1) & cel.Address(0, 0) & " " Else dic.Add ItemVal, "1#" & cel.Address(0, 0) & " " End If End If Next Dim rslt() Dim brd ReDim rslt(0 To Application.Max(0, dic.Count - 1)) NN = 0 For Each eachKey In dic AdrsBreak = Split(dic(eachKey), "#") Adrs = Replace(RTrim(AdrsBreak(1)), " ", ",") Adrs = AddressUnited(Adrs) 'バラバラのAddressを統合 For Each brd In Split(Adrs, "#!#") If brd <> "" Then dataToFil = IIf(Application.IsText(eachKey), """", "") & Replace(eachKey, """", """""") & _ IIf(Application.IsText(eachKey), """", "") dataToFil = Replace(modelFMS, "Adrs", brd) & dataToFil NN = NN + 1 If NN - 1 > UBound(rslt) Then ReDim Preserve rslt(0 To NN - 1) End If rslt(NN - 1) = dataToFil End If Next Next sameKindS = rslt End Function Private Function AddressUnited(adr) 'バラバラのAddressを統合 Dim scopeRange As Range Dim adrRemain As String Dim adrForRowProc As String Dim adrForColProc As String Set scopeRange = Range(Split(adr, ",")(0)) adrRemain = "," & adr & "," Do While Not scopeRange Is Nothing uniteRowDir scopeRange, adrRemain adrForRowProc = adrForRowProc & scopeRange.Address(0, 0) & "," If Len(adrRemain) < 4 Then Set scopeRange = Nothing Else Set scopeRange = Range(Split(adrRemain, ",")(1)) End If Loop Set scopeRange = Range(Split(adrForRowProc & ",", ",")(0)) adrRemain = "," & adrForRowProc Do While Not scopeRange Is Nothing uniteColDir scopeRange, adrRemain adrForColProc = adrForColProc & scopeRange.Address(0, 0) & "," If Len(adrRemain) < 4 Then Set scopeRange = Nothing Else Set scopeRange = Range(Split(adrRemain, ",")(1)) End If Loop AddressUnited = get小分け(adrForColProc) '10セル以上は長いので同じ構文でも分割作成 End Function Function get小分け(adrForColProc) Dim strSRC Dim brDown, Cntr, sss, QQ, adrsUnit, numOfadrs brDown = Split(adrForColProc, ",") numOfadrs = UBound(brDown) '対象個数 adrsUnit = Int((numOfadrs - 1) / 10) + 1 adrsUnit = Application.RoundUp(UBound(brDown) / adrsUnit, 0) 'まとめるアドレスの数 For Cntr = 0 To numOfadrs - 1 Step adrsUnit sss = stEd(Cntr, Application.Min(numOfadrs - 1, Cntr + adrsUnit - 1), brDown) strSRC = IIf(strSRC = "", sss, strSRC & "#!#" & sss) Next Cntr get小分け = strSRC & "#!#" End Function Function stEd(st, ed, ary) Dim NN, str str = ary(st) For NN = st + 1 To ed str = str & "," & ary(NN) Next NN stEd = str End Function Private Sub uniteRowDir(ByRef scopeRange, ByRef adrRemain) Dim brdAry brdAry = Split(adrRemain, ",") adrRemain = Replace(adrRemain, "," & brdAry(1) & ",", ",") 'アドレス文字列から除外 If Range(brdAry(1)).Cells(1, 2).Address(0, 0) = brdAry(2) Then '右横に同じものあり Set scopeRange = Range(scopeRange, Range(brdAry(2))) uniteRowDir scopeRange, adrRemain End If End Sub Private Sub uniteColDir(ByRef scopeRange, ByRef adrRemain) '直下が同じ範囲かチェック Dim brdAry Dim adrsUnder As String brdAry = Split(adrRemain, ",") adrRemain = Replace(adrRemain, "," & scopeRange.Rows(scopeRange.Rows.Count).Address(0, 0) & ",", ",") 'アドレス文字列から除外 adrsUnder = scopeRange.Rows(scopeRange.Rows.Count + 1).Address(0, 0) '結合セル対策 If adrRemain Like "*," & adrsUnder & ",*" Then '真下に同じものあり Set scopeRange = Range(scopeRange, Range(adrsUnder)) uniteColDir scopeRange, adrRemain End If End Sub 'ここまで（半平太） 2018/04/03(火) 19:50 ---- 半平太さんへまず沢山記載していただき有難うございます。＞長引くかも知れないので、以後「さん」付けでお願いします。わかりました。＞範囲は、b1:ai52 です。＞ A1セルからじゃないんですか・・、ちょっと不思議。 A列は、印刷時に余白の調整をするために作っただけです。＞しかも見積書としては、尋常じゃなく広範囲ですね。＞結合セルが多いセイなんですかねぇ。最初、年月日を年月日の数値をコントロールボタンを使って選ぶ為、あるいは、、配置の項目によっては、表の上の方と下の方とでは、セル幅の位置に違いあるので、細かいセルを作りました。（これが完成しましたらセル幅を少なくしてやりかえようかと思っています。）＞yからab（結合）acからaj（結合）＞照会番号 1234568 ＞発行日 2018/4/1 ＞ Q1. その「照会番号」をキーとしていいんでしょうか?（本当に存在するデータなのですか?）はい、本当に存在するデータです。一つの取引で、見積書と納品書と請求書を同じ番号にします。＞貼付順番がバラバラの為に、範囲の選定に誤りがあるかと＞思い範囲の指定を変えるとともに、保存を実行しましたら、一部ですが、下記のように誤った結果になりましたので、範囲の選定にあやまりが、あるかと思い---と記載しました。 Q列 Y列 1行 B28 B30 2行見積内訳見積内訳 3行郵便番号住所正しいのは、郵便番号の位置は、D列の一行目がB7です。住所の位置は、E列の1行目がB8です。＞シート名:保存の1行目と2行目は、自分でセル番地と項目名を手入力しました。＞見積内訳の列は、B27からX27までです。が、名前ボックスの保存範囲は、B列だけです。 Q2. ここの部分がちょっと分からないです。これは、B27からX27迄を結合して保存範囲にしたのではなくB列27だけを範囲としましたということです。上の方で、AC5とかAC6とかあったと思うんですけど、そこをご自分で書いたのですか?（機械に任せないと食い違いが起きます）はい自分で書きました。それは、照会番号のデータがAC5にあり、発行日のデータがAC6にあるので書きました。 1行目は、データのセルではないのですか? とりわけここまで先にアップします。今から、＞見積書シートをこちらで再現するため、以下の方法を使います。を実行してまいります。（謙児） 2018/04/03(火) 23:39 ---- 半平太さんおはようございます。下記の文章は、コメントではないので、書く必要は、ないかもしれませんが、私からの返信が下記理由により遅くなりましたら、半平太さんの方で上手くいっていないのかなあと再度調べられては申し訳ないので、記載しました。悪しからず。〉今から見積書シートをこちらで再現するため、以下の方法を使います。を昨夜しようと思ったのですが、2・3、日前から目が痛く止めてしまいました。今日は、色々な会議が続きます。折角色々、精査して頂いていますのに申し訳なく思います。すみません。（謙児） 2018/04/04(水) 09:25 ---- ＞上手くいっていないのかなあとお気遣いは無用です。心配のネタとしては、結合セルが大量にあるかも知れない点だけです。昔、作ったプログラムなので、大量の結合セルをどこまで許容する作りにしたか、もう忘れています。いずれにしても、そちらの結果レスが入ってから検討に入ります。（半平太） 2018/04/04(水) 10:21 ---- Private Sub onlyOnce() Rem ' Range("'[4月3日転記するb91からdc91を省く半平太 - コピー.xlsm]見積書'!$B$1:$AJ$52").Clear Rem 結合状態を処理 Range("B1:AI1").Merge Range("M3:Y3").Merge Range("Y5:AB5").Merge Range("AC5:AI5").Merge Range("Y6:AB6").Merge Range("AC6:AI6").Merge Range("Y13:AH13").Merge Range("AB14:AH14").Merge Range("Y15:AB15").Merge Range("AC15:AE15").Merge Range("Y16:AB16").Merge Range("Y17:AA17").Merge Range("AC17:AE17").Merge Range("B18:F18").Merge Range("G18:M19").Merge Range("Y18:AA21").Merge Range("AC18:AE21").Merge Range("B19:F19").Merge Range("G21:M21").Merge Range("G22:M22").Merge Range("G23:M23").Merge Range("AE25:AI25").Merge Range("B26:X26").Merge Range("Y26:AB26").Merge Range("AC26:AD26").Merge Range("AE26:AI26").Merge Range("Y27:AB27").Merge Range("AC27:AD27").Merge Range("AE27:AI27").Merge Range("Y28:AB28").Merge Range("AC28:AD28").Merge Range("AE28:AI28").Merge Range("Y29:AB29").Merge Range("AC29:AD29").Merge Range("AE29:AI29").Merge Range("Y30:AB30").Merge Range("AC30:AD30").Merge Range("AE30:AI30").Merge Range("Y31:AB31").Merge Range("AC31:AD31").Merge Range("AE31:AI31").Merge Range("Y32:AB32").Merge Range("AC32:AD32").Merge Range("AE32:AI32").Merge Range("Y33:AB33").Merge Range("AC33:AD33").Merge Range("AE33:AI33").Merge Range("Y34:AB34").Merge Range("AC34:AD34").Merge Range("AE34:AI34").Merge Range("Y35:AB35").Merge Range("AC35:AD35").Merge Range("AE35:AI35").Merge Range("Y36:AB36").Merge Range("AC36:AD36").Merge Range("AE36:AI36").Merge Range("Y37:AB37").Merge Range("AC37:AD37").Merge Range("AE37:AI37").Merge Range("Y38:AB38").Merge Range("AC38:AD38").Merge Range("AE38:AI38").Merge Range("Y39:AB39").Merge Range("AC39:AD39").Merge Range("AE39:AI39").Merge Range("Y40:AB40").Merge Range("AC40:AD40").Merge Range("AE40:AI40").Merge Range("Y41:AB41").Merge Range("AC41:AD41").Merge Range("AE41:AI41").Merge Range("Y42:AB42").Merge Range("AC42:AD42").Merge Range("AE42:AI42").Merge Range("Y43:AB43").Merge Range("AC43:AD43").Merge Range("AE43:AI43").Merge Range("Y44:AB44").Merge Range("AC44:AD44").Merge Range("AE44:AI44").Merge Range("Y45:AD45").Merge Range("AE45:AI45").Merge Range("Y46:AD46").Merge Range("AE46:AI46").Merge Range("Y47:AD47").Merge Range("AE47:AI47").Merge Range("Y48:AD48").Merge Range("AE48:AI48").Merge Range("D49:AI49").Merge Range("D50:AI50").Merge Range("D51:AI51").Merge Range("D52:AI52").Merge Rem 数式セル以外をまとめて処理 Range("M3").Value = "お見積書" Range("Y5").Value = "照会番号" Range("AC5").Value = 567890 Range("Y6").Value = "発行日" Range("AC6").Value = 43191 Range("B7,Y8").Value = "〒XXX-XXXX" Range("B8,Y9").Value = "東京都新宿区" Range("B9,Y10").Value = "新宿第一ビル" Range("B10").Value = "〇〇〇〇〇株式会社御中 " Range("B11,Y12").Value = "△△△△様" Range("Y11").Value = "〇〇〇〇〇株式会社" Range("Y13").Value = "担当 :xxxx xxxx" Range("B14").Value = "この度は弊社に見積の機会をお与えくださいまして誠に" Range("Y14").Value = "E-mail: " Range("AB14").Value = "xxxxxxxx" Range("B15").Value = "有難うございます。下記のとおりお見積り申し上げます。" Range("Y15").Value = "担当部署 :" Range("AC15").Value = "製造" Range("B16").Value = "ご検討の程よろしくお願い申し上げます。" Range("Y17").Value = "担当印" Range("AC17").Value = "承認印" Range("B18").Value = "お見積金額" Range("G18").Value = 32357 Range("B19").Value = "（消費税含みます。）" Range("B20").Value = "納品場所 " Range("G20").Value = "ご指定の場所" Range("B21").Value = "納期 " Range("G21").Value = 43205 Range("B22").Value = "本見積有効期限 " Range("G22").Value = 43238 Range("B23").Value = "支払い条件" Range("G23").Value = "納入月末締め、翌月末振込" Range("B25").Value = "明細" Range("B26").Value = "見積内訳" Range("Y26").Value = "単価" Range("AC26").Value = "数量" Range("AE26").Value = " 金額" Range("B27").Value = "A機械" Range("Y27").Value = 100000 Range("AC27").Value = 1 Range("B28").Value = "B機械" Range("Y28").Value = 101000 Range("AC28").Value = 2 Range("B29").Value = "C機械" Range("Y29").Value = 102000 Range("AC29").Value = 3 Range("B30").Value = "D機械" Range("Y30").Value = 103000 Range("AC30").Value = 4 Range("B31").Value = "E機械" Range("Y31").Value = 104000 Range("AC31").Value = 5 Range("B32").Value = "F機械" Range("Y32").Value = 107000 Range("AC32").Value = 6 Range("B33").Value = "G機械" Range("Y33").Value = 108000 Range("AC33").Value = 7 Range("B34").Value = "H機械" Range("Y34").Value = 109000 Range("AC34").Value = 8 Range("B35").Value = "I機械" Range("Y35").Value = 110000 Range("AC35").Value = 9 Range("B36").Value = "J機械" Range("Y36").Value = 111000 Range("AC36").Value = 10 Range("B37").Value = "K機械" Range("Y37").Value = 112000 Range("AC37").Value = 11 Range("B38").Value = "L機械" Range("Y38").Value = 113000 Range("AC38").Value = 12 Range("B39").Value = "M機械" Range("Y39").Value = 114000 Range("AC39").Value = 13 Range("B40").Value = "N機械" Range("Y40").Value = 115000 Range("AC40").Value = 14 Range("B41").Value = "O機械" Range("Y41").Value = 116000 Range("AC41").Value = 15 Range("B42").Value = "P機械" Range("Y42").Value = 117000 Range("AC42").Value = 16 Range("B43").Value = "Q機械" Range("Y43").Value = 118000 Range("AC43").Value = 17 Range("Y44").Value = "数量,金額合計" Range("Y45").Value = 0.2 Range("Y46").Value = "小計" Range("Y47").Value = 0.08 Range("Y48").Value = "お見積り合計金額" Range("B49").Value = "備考:" Range("D49").Value = "割引は、20%になります。" Range("D50").Value = "今後の取引状況で割引率は、上がります。" Range("D51").Value = "余白1" Range("D52").Value = "余白2" Rem 数式セルをまとめて処理 Range("AE27:AE43").FormulaR1C1Local = "=RC[-6]*RC[-2]" Range("AC44").FormulaR1C1Local = "=SUM(R[-17]C:R[-1]C[1])" Range("AE44").FormulaR1C1Local = "=SUM(R[-17]C:R[-1]C[4])" Range("AE45").FormulaR1C1Local = "=R[-1]C*0.2" Range("AE46").FormulaR1C1Local = "=R[-2]C-R[-1]C" Range("AE47").FormulaR1C1Local = "=R[-1]C*0.08" Range("AE48").FormulaR1C1Local = "=R[-2]C+R[-1]C" Rem 標準外書式セルをまとめて処理 Range("AD3:AD4,AD7:AD12,AD16,AD22:AD25,Y27:AB43,AE27:AI35,AE36:AJ36").NumberFormatLocal = "#,##0;[赤]-#,##0" Range("AE37:AI43,Y44:AJ44,AE45:AI45,Y46:AI46,AE47:AI47,Y48:AI48").NumberFormatLocal = "#,##0;[赤]-#,##0" Range("AC6,G21:G22").NumberFormatLocal = "yyyy/m/d" Range("AE25").NumberFormatLocal = "#,##0" Range("C37:E37").NumberFormatLocal = "@" Range("Y45:AD45").NumberFormatLocal = """割引"" 0%;;" Range("Y47:AD47").NumberFormatLocal = """消費税"" 0%;;" Rem 塗りつぶしセルをまとめて処理 Range("B1:AI1").Interior.ColorIndex = 50 Range("M3:Y3").Interior.ColorIndex = -4105 Range("AC5:AC6,B7:I11,Y8:AI12,G18:M19,G21:G22,G23:M23,B26:AI26,AE44:AI48,D49:AI50").Interior.ColorIndex = 6 Range("B27:AI27,AE28:AI28,B29:AI29,AE30:AI30,B31:AI31,AE32:AI43").Interior.ColorIndex = 24 Range("C33:X33,C35:X35,C37:X37,C39:X39,C41:X41,C43:X43").Interior.ColorIndex = 24 Range("Y48:AD48").Interior.ColorIndex = 35 End Sub （謙児） 2018/04/05(木) 00:29 ---- 上記に貼り付けました。データの位置づけがわかるのですね、すごいですね。よろしくお願いいたします。（謙児） 2018/04/05(木) 00:32 ---- こちらで見積書を再構築できました。m(__)m 今後は、コピーしたブックを「テストブック」と呼ぶことにします。テストブックの「保存範囲」は以下かと思いますが、合っていますか? 「AC5:AI6,B7:B11,G18,G20,G21:M23,B27:AD43,Y45,Y47,D49:AI52」目で確認するには、以下のプログラムを実行して、選択範囲をチェックしてください。 sub 範囲確認 Range("AC5:AI6,B7:B11,G18,G20,G21:M23,B27:AD43,Y45,Y47,D49:AI52").select end sub B49も含めるのかどうか分かりませんでした。「備考:」は、有っても無くてもその位置にタイトルだけは書くのですか?（決まり文句、決まり位置なのですか?）（半平太） 2018/04/05(木) 10:25 ---- 半平太さん早速のご返事有難うございます。＞今後は、コピーしたブックを「テストブック」と呼ぶことにします。承知いたしました。下記は、範囲の調整です。 AC5:AI5 , AC6:AI6 は、別々の項目です。 B7:B11は、正しいです。 G18は、正しくは、G18:M19の結合です。G20は、不要です。その代わりに追加が、G21:M21（結合）,G22:M22（結合）G23:M23（結合）です。 B27:AD43は、正しいです。Y45,Y47は、不要です。AC44:AD44（追加です） D49:AI52は、正しいです。＞B49も含めるのかどうか分かりませんでした。「備考:」は、有っても無くてもその位置にタイトルだけは書くのですか? その通りです。データがあってもなくても表示するだけです。ですから保存の範囲には入れませんが、保存先の見出しに"備考"をつけるつもりです。気になりますのは、 1、AE27:AI48迄（金額）計算式が入っていますが、上記説明で計算式を外すとありましたが、保存の時には合計の見出しと金額が入るのでしょうね。 2、見積内容の記載範囲（B27:X43）は、B列からX列まで23列ですが、セルの範囲としては、B列のみです。仮にB27行目のデータが最後の列X27迄記載されたとしましても保存先には全部のデータが23列分使って横並びに表示されるのでしょうか? 以上です。2回見直したのですが、よろしくお願いいたします。（謙治） 2018/04/05(木) 14:51 ---- 追伸 B27:AD43の内、項目名は、見積内容と単価と数量がはいっていますが、項目毎にセル範囲を区分するのですね。今から会議に入りますが、後で確認します。（謙児） 2018/04/05(木) 15:15 ---- ＞AC5:AI5 , AC6:AI6 は、別々の項目です。済みませーん。実際にデータが入っているかどうかで、保存範囲を把握する必要があることを失念しました。m(__)m ※セルを結合すると、実際のデータは左上の1セルにしかありません。←（これ重要）なので、「AC5:AC6」が正しい認識になります。＞G18は、正しくは、G18:M19の結合です。実際にデータが入っているのは「G18」だけなので、「G18」が正しいです。ところで、見積額 G18(32357）とAE48(14,867,712）が合致しないのは何故ですか? G18は数式ではない事になっていますが、本当なんですか? ＞G20は、不要です。私は、実際に「指定された場所情報」を書くのかと思ったのですが、「ご指定の場所」と言う決まり文句でしたか・・・、その様に理解します。＞その代わりに追加が、G21:M21（結合）,G22:M22（結合）G23:M23（結合）です。これらは、実際にデータが入っているのは、「G21:G23」と言うことになります。＞B27:AD43は、正しいです。これは「見積内容の記載範囲（B27:X43）は、・・セルの範囲としては、B列のみです。」とのお話がありましたので「B27:B43」「Y27:Y43」「AC27:AC43」に分割します。＞Y45,Y47は、不要です。決まり文句と理解しました。＞AC44:AD44（追加です）実際に数式が入っているのはAC44だけです。ただ、数式は保存する予定は（私としては）無いです。（これについては後述します）＞D49:AI52は、正しいです。実際に数式が入っているのは「D49:D52」だけです。＞＞B49も含めるのかどうか分かりませんでした。＞保存先の見出しに"備考"をつけるつもりです。保存シートの2行目は、機械が利用しないところなので、後で手作業で何とでも調整できます。＞気になりますのは、＞1、AE27:AI48迄（金額）計算式が入っていますが、上記説明で計算式を外すとありましたが、保存の時には＞合計の見出しと金額が入るのでしょうね。私の予定では数式のデータは入れません。数式で算出したデータも保存すると、照会番号を入れて保存データを呼び戻した時、見積表にある数式が壊れてしまいます。保存シートにあるデータは必要最小限のものです。本質的には人間が見て利用するものじゃないです。ただ、そうは言っても、実際に別の目的で使うことがあるのかも知れません。そうだとすれば、どんな対処をすれば最適か、利用目的に沿って考察する必要があります。 ※例えば、保存の時は書込みをするが、呼び出しの時は無視させる、とか人間用に別シート（例:ダイジェストシート）を用意する、とかです。人間用は細かいデータは必要ないであろうと思っています（多分）。【照会番号、取引先名、日付、合計金額】位なものじゃないですか? 人間用のダイジェストシートがあると、何かと便利なこともあります。例えば、取引先を入れるとその取引先だけの照会番号の一覧を出したりする、とか。（これが、大がかりな保存シートだと、並べ替えをしたりするのに心理的な抵抗があります。）＞追伸＞B27:AD43の内、項目名は、見積内容と単価と数量がはいって＞いますが、項目毎にセル範囲を区分するのですね。上の方でも書きましたが、1行保存なので、人間が見るには不適切なレイアウトです。人間が見る為の配慮は2の次、3の次にしか考えておりません。保存シートのデータをどう再利用したいと思っておられるのか、それを書いて頂ければ、何らかのアジャストは可能ではないかとは思っています。一つの案が、上述のダイジェストシート作成です。 ============================ 以上の結果を踏まえますと、保存べき範囲は以下のとなります（取りあえず、数式セルは含まないベース）「AC5:AC6,B7:B11,G18,G21:G23,B27:B43,Y27:Y43,AC27:AC43,D49:D52」保存範囲の視認は下のプログラムで行ってください。対象範囲は選択されます。 Sub 範囲確認() Range("AC5:AC6,B7:B11,G18,G21:G23,B27:B43,Y27:Y43,AC27:AC43,D49:D52").Select End Sub ============================ 保存されるデータは以下となります。（実際にデータが入っていない場合は、空白となります） 567890 2018/04/01 〒XXX-XXXX 東京都新宿区新宿第一ビル〇〇〇〇〇株式会社御中 △△△△様 32357 2018/04/15 2018/05/18 納入月末締め、翌月末振込 A機械 B機械 C機械 D機械 E機械 F機械 G機械 H機械 I機械 J機械 K機械 L機械 M機械 N機械 O機械 P機械 Q機械 100000 101000 102000 103000 104000 107000 108000 109000 110000 111000 112000 113000 114000 115000 116000 117000 118000 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 割引は、20%になります。今後の取引状況で割引率は、上がります。余白1 余白2 （半平太） 2018/04/05(木) 19:17 ---- 結論からですが、項目範囲が、全てうまく行きました。有難うございました。お手数をおかけしました。以下は、途中での返答です。 >なので、「AC5:AC6」が正しい認識になります。 ac5とac6は、結合していませんが---。 >ところで、見積額 G18(32357）とAE48(14,867,712）が合致しないのは何故ですか? > G18は数式ではない事になっていますが、本当なんですか? すみません、正しくは、G18のセルは、=AE48で答えは、14,867,712となります。合致しないのは、こちらの手違いでした。（当初G18のセルは、式で G18=シート名:フォームコントロールの合計金額結果、32357（数値）にしていました。その後私の勘違いで計算式は、入れないと言われたことを例えばG18=シート名:フォームコントロールの合計金額、これも計算式だと思い全て数値になおしていました。他の項目データも同じように数値で表示しました。その後で半平太さんのチェックの為にAE列を全て入力したのですが、その時にG18=AE48にするのを忘れていました。）改めてですが、シート名:見積書の各項目のデータは、=シート名:フォームコントロールの各項目の式になおしても宜しいか? ＞「ご指定の場所」と言う決まり文句でしたか・・・、その様に理解します。そのようにお願いします。＞これらは、実際にデータが入っているのは、「G21:G23」と言うことになります。理解しました。＞「見積内容の記載範囲（B27:X43）は、・・セルの範囲としては、B列のみです。」とのお話がありましたので「B27:B43」「Y27:Y43」「AC27:AC43」に分割します。理解しました。＞＞保存先の見出しに"備考"をつけるつもりです。＞保存シートの2行目は、機械が利用しないところなので、後で手作業で何とでも調整できます。理解しました。＞保存シートのデータをどう再利用したいと思っておられるのか、＞それを書いて頂ければ、何らかのアジャストは可能ではないかとは思っています。＞一つの案が、上述のダイジェストシート作成です。使用する人が、見積書の項目データを保存した後で、シート名:保存で過去のデータを参照するときに合計額は、ありますが、一行毎の単価×数量=金額の金額がなければ、金額がないよと言われそうなので、表示させて頂ければ有り難いと思います。もし面倒なれば、使う人に計算式は、データ扱いで表示できません、確認をしたければ照会番号をキーにしてシート名:見積書にデータを入れて見て下さい、と言います。＞保存範囲の視認は下のプログラムで行ってください。対象範囲は選択されます。＞保存されるデータは以下となります。（実際にデータが入っていない場合は、空白となります）有難うございます。希望通りに範囲の選択は、行われています。教えて頂きたいのですが、B27からB43迄のデータは、今はB列だけですが、見積り内容の範囲内で例えば、B27からX27迄データがあるとしてもシート名:保存に表示されますよね。シート名:見積書で、各項目データの式、=シート名:フォームコントロール(各項目データ）（謙児） 2018/04/05(木) 22:53 ---- 上記、最後記載の文章で、シート名:見積書で、各項目データの式、=シート名:フォームコントロール(各項目データ）と書いているのは、、消し忘れで不要です。間違いです。すみません。（謙児） 2018/04/06(金) 03:26 ---- ＞なので、「AC5:AC6」が正しい認識になります。 ac5とac6は、結合していませんが---。結合とは無関係です。別々にAC5、AC6 としても、合わせてAC5:AC6 としても殆んど同じです。 ※結合セルなら、左上のセルしか意味を為さないので、単にAC5と云う表現になります。＞正しくは、G18のセルは、=AE48で答えは、14,867,712となります。そうなると、G18は数式なので、保存対象から外れますよ。＞使用する人が、見積書の項目データを保存した後で、シート名:保存で過去のデータを参照するときに＞合計額は、ありますが、一行毎の単価×数量=金額の金額がなければ、金額がないよと言われそうなので、＞表示させて頂ければ有り難いと思います。何度も書いていますが、保存シートのデータは人間が見て分かる様なレイアウトではありません。そんな所を見に行かなくても、満足して貰えるような何らかの手当をするべきなんです。第一、「金額明細がない」と分かったところで、その後、その利用者に何の足しがあるんでしょうか? 「合計金額」ならまだ何か役に立つでしょうが、その金額明細なんて使いようがないと思うんですけども。＞もし面倒なれば、使う人に計算式は、データ扱いで表示できません、確認をしたければ照会番号をキーに＞してシート名:見積書にデータを入れて見て下さい、と言います。それで使う人に納得して貰えれば、確かに面倒がなくて助かります。でも、私が使う人だったら、取引先名を入れるだけで、その会社に関連する取引の照会番号(・日付・総額）とかの一覧が出て、そこで目的の照会番号を選ぶと、見積書の形で取引が見える・・とか、一旦、一つの取引が見れたら、その前の取引とか、次の取引がワンクリックで次々に見える・・とかになって欲しいと思いますけどね。いずれにしても、人間には見積書(又はそれと同じ様式）の形で見せるようにしなければならない。そうじゃないと、結局、みづらい・使いづらい、との不満が噴出することになると思います。。具体的なフローが私には分からないのですが、ある取引を処理しようとすると、その取引の「照会番号」を知っている必要がありますよね? 目的の照会番号はどうやって認知・取得出来るんですか? その認知に至るまでの過程がスムーズに運ばなければ全てがギクシャクします。謙児さんは、そこのところには問題が起きない自信があるんですか? ＞教えて頂きたいのですが、B27からB43迄のデータは、今はB列だけですが、見積り内容の範囲内で＞例えば、B27からX27迄データがあるとしてもシート名:保存に表示されますよね。表示されないです。「今はB列だけ」なんて仕様は無しです。今後生じることなら、今は無くても、今から準備しておかなければならないです。するとこの話も無しです。 ↓ ＞「見積内容の記載範囲（B27:X43）は、・・セルの範囲としては、B列のみです。」とのお話がありましたので＞「B27:B43」「Y27:Y43」「AC27:AC43」に分割します。後戻りして、以下になります。「B27:X43」「Y27:Y43」「AC27:AC43」でも分からないですねぇ・・・「B27:X43」にデータが入ってくるとして、本当に全部埋まることがあるんですか? どんなデータなのか私には分からないですが、狭い見積書に全部表示できるものなんですか? 私としては、B〜Xは結合してしまい、一行まとめて入力したらどうかなぁと思うんですけど、そうもいかないんですか? なんたって、C27からX43まで追加されたら、余分に374列必要になります。尋常な数じゃないですよ? （半平太） 2018/04/06(金) 08:48 ---- 半平太さんおはようございます。＞＞正しくは、G18のセルは、=AE48で答えは、14,867,712となります。＞そうなると、G18は数式なので、保存対象から外れますよ。では、見積書の各データは、シート名:フォームコントロールの各項目に入力したデータを見積書の同項目に=シート名:フォームコントロールとしたいのですが、(現段階では、デスクトップのファイルは、あえて数値になおしていますが、） =を使うことが数式になるため、=が使えないという事でしょうか? そしたらシート名:見積書に直接入力をしないといけないということですね。そうなると日付ボタンは、使えないのですか?（今は、シート名:フォームコントロールの日付ボタンは、平成年、月日その間にボタンで数字を選ぶようにして別のセルN19に =DATE(H19,J19,L19) として西暦になおしシート名:見積書の日付欄に=シート名:フォームコントロールN19 としています。＞何度も書いていますが、保存シートのデータは人間が見て分かる様なレイアウトではありません。＞そんな所を見に行かなくても、満足して貰えるような何らかの手当をするべきなんです。＞第一、「金額明細がない」と分かったところで、その後、その利用者に何の足しがあるんでしょうか? ＞合計金額」ならまだ何か役に立つでしょうが、その金額明細なんて使いようがないと思うんですけども言われてみればその通りですね。わかりました。（金額明細の表示は、ないままでお願いします。）＞でも、私が使う人だったら、取引先名を入れるだけで、＞その会社に関連する取引の照会番号(・日付・総額）とかの一覧が出て、＞そこで目的の照会番号を選ぶと、見積書の形で取引が見える・・とか、＞一旦、一つの取引が見れたら、その前の取引とか、次の取引がワンクリックで＞次々に見える・・とかになって欲しいと思いますけどでも、先ほどの数式が入っている金額明細の話（すでに表示しないことを理解しています）以外は、以前にも記載された、その前の取引とか、次の取引がワンクリックで次々に見える--- 事を聞かされて、そういうことが出来るんだ、私は、そういうことが出来たらいいなあと思っていましたので、実は、そこにたどり着くことを楽しみにしているのです。という事で、私は、上記で言われるように、半平太さんの言われるようにしていきたいのですよ。＞いずれにしても、人間には見積書(又はそれと同じ様式）の形で見せるようにしなければならない。見積書の形でみせるように---私もそれを望んでいましたから、当初金額明細の表示を入れてくださいと言ったまでなんですよ。（現時点では、何回も言って申し訳ありませんが、その必要はありませんので）＞ある取引を処理しようとすると、その取引の「照会番号」を知っている必要がありますよね? ＞目的の照会番号はどうやって認知・取得出来るんですか? 照会番号は、見積書を作る担当者に入力をして頂きます。その照会番号が、納品書、請求書の照会番号にも同じ番号をつけます。＞私としては、B〜Xは結合してしまい、一行まとめて入力したらどうかなぁと思うんですけど、＞そうもいかないんですか? いえいえ、いけますよ、嬉しいです。なぜならシート名:保存のマクロコード実行する時点では、 B〜Xを結合していたのです。実行後、保存結果が適正な配置にいかないので、たくさんの列を結合することがよくないのかと思い結合を外しました。 B〜X迄結合しますが、そちらの準備等もあるかとおもいますから結合してよい時には、言ってください。それに合わせて見積書のセル幅を細かくしないで標準セルでやり直しましょうか? （何か所かは、セル幅の狭い箇所も必要ですが、半平太さんに手を煩わしすぎてもいけませんからこれもやり直すのであれば改めて言ってください）＞「B27:X43」にデータが入ってくるとして、本当に全部埋まることがあるんですか? 担当者に過去の見積書を見せてもらったのですが、見積内容は、多いところで1行20文字位行数は、16行分です。 27行から43行目(各セル幅は10以下です）までは、実際には、使わないと思います。見積内容は、1行ごとに単価、数量、金額を記載するものとは限らず、1行目に入れる文字を 2行目にわたって関連文字をゆったりと入れている場合もあります。見積内容の記載は、担当者が任意で記載、記入していただくところですから、万一文字列が多くなってもシート名:保存に転記する時点で文字数が足らなくならないように、余分に設けただけです。＞なんたって、C27からX43まで追加されたら、余分に374列必要になります。＞尋常な数じゃないですよ? CからX、27から43迄、縦横かけるので保存先の列は、374列分必要になるのですね。知らなかったとは言え到底そんな列を作るなんてナンセンスですね。失礼しました。結論は、金額明細の件を外して半平太さんのアイデアで進めて頂ければ喜ばしいことです。お願いします。＞いずれにしても、人間には見積書(又はそれと同じ様式）の形で見せるようにしなければならない。そうじゃないと、結局、みづらい・使いづらい、との不満が噴出することになると思います。。（謙治） 2018/04/06(金) 11:34 ---- 上記の文章で最後の＞いずれにしても、人間には見積書(又はそれと同じ様式）の形で見せるようにしなければならない。＞そうじゃないと、結局、みづらい・使いづらい、との不満が噴出することになると思います。は、前もってコピーしていたものが残っていました。不要です。（同じことを2回しました、今後注意します。すみません）上記で記述するのを忘れていましたが、B列 B27からB43迄のデータをB列だけに記載しましたのは、＞そちらの作業＞ 3.長い文字列は簡単な表現に換えると書かれてあったので文字数を1列分だけにしました。以上です。＞（謙治） 2018/04/06(金) 12:16 ---- ＞見積書の各データは、シート名:フォームコントロールの各項目に入力したデータを＞見積書の同項目に=シート名:フォームコントロールとしたいのですが、＞(現段階では、デスクトップのファイルは、あえて数値になおしていますが、） :: ＞シート名:保存のマクロコード実行する時点では、＞B〜Xを結合していたのです。実行後、保存結果が適正な配置にいかないので、＞たくさんの列を結合することがよくないのかと思い結合を外しました。あれれ? そんな加工が為されていたんですか（とほほ）それでは、見積書シートの再構築が出来てないのと同然なんですけどぉー。私としては、「重要情報」の書換えと「長い文言」の短縮化だけで、ありのままの状態と思っていました。実は数式だったとすると前提が全く変わります。謙治さんは、数式データが何故保存対象に出来ないか、分かっていないようですね。 3月1日、見積もりをやったとしましょう。日付欄に=フォームコントロールN19 としてあるので、めでたく「3月1日」となっています。見積書データを保存しました。日付は値化した「3月1日」で保存されます。 3月14日に、「3月1日の見積書」を呼び出して、納品書づくりに使いました。そこまではいいですが、その次に別の新規見積書を作ろうとすると、あれ?、日付が3月14日になってくれない! ってことになります。何故って、見積書の日付のセルにはもう「=フォームコントロールN19」が壊され、3月1日の値が居座っているからです。じゃ、どうすればいいかと言うと、3月14日の呼び出しの時、数式を壊さない為、日付欄には直接戻さず、フォームコントロールの「H19,J19,L19」に3月1日になる様なデータを入れることになります。他の数式もそんな風に、大元のデータが何処にあるかを調べて対処しないとならないです。でも、そんな曲芸的な仕掛けを作るのは気が進まないです。兎に角、こちらは見積書シートについての知識が瓦解してしまったので、アイデアが浮かびません。謙治さんが気を使ってやったことなので、怒る事もできません。もう一度、ありのままの状態で見積書の再現コードを作って頂くほかないと思いますけども。それと最低限、フォームコントロールシートについても再現コードが必要になりますが、それがどんなシートなのか今は全く分かりません。私としては、フォームコントロールシートをメニューシートの位置づけに出来ればいいのだが、と思っています。（半平太） 2018/04/06(金) 14:40 ---- 半平太さん色々迷惑をおかけしてすみませんでした。＞何故って、見積書の日付のセルにはもう「=フォームコントロールN19」が壊され、3月1日の値が居座ってい＞るからです。 3月1日の値が居座るのは、シート名:保存のところであって、元の見積書の日付セル、「=フォームコントロールN19」またはその他の項目のセル「=フォームコントロール」のコピー元が何故壊れるのかがわかりません。教えて頂けますか? ＞じゃ、どうすればいいかと言うと、3月14日の呼び出しの時、数式を壊さない為、日付欄には直接戻さず、日付欄には直接戻さずとは、見積書の日付欄ですか?（G18）＞フォームコントロールの「H19,J19,L19」に3月1日になる様なデータを入れることになります。入れ終わったら見積書の各項目データにどうつなぐのですか?わたしが行ったように「=フォームコントロール」でつなげば数式がこわれますよね。＞私としては、フォームコントロールシートをメニューシートの位置づけに出来ればいいのだが、と思ってい＞ます。位置づけに出来ればとは、どういうふうにするのですか? 現在、フォームコントロールシートをメニューシートの位置づけにしている（式で=フォームコントロールxx）と思いますが。と言いながら半平太さんが壊れると言っていますから別の意味を言ってそうな気はしますが。＞もう一度、ありのままの状態で見積書の再現コードを作って頂くほかないと思いますけども。＞それと最低限、フォームコントロールシートについても再現コードが必要になりますが、頑張ってやってみます。一度洗いなおしてフォームを変えます。（仕事の合間にしますから編集時間はかかりますが待っていてください。必ずやります。） 1、セル幅を標準にします。（見積書の項目範囲でセル幅が少ないところも出ますが） 2、幅が広くなければいけないところは、結合します。次から質問ですが、シート名:フォームコントロールシートで色々ボタンを利用して（例えば支払先で、あらかじめ登録した名前を選択すると関連した支払先の〒番号、住所、見積内容が、表示されます。）シート名:見積書に=でつないでいますが、=の式になっているためフォームコントロールシート7は、やめた方がいいのでしょうか? それとも、やめないとすれば、＞私としては、フォームコントロールシートをメニューシートの位置づけに出来ればいいのだが、と思ってい＞ます半平太さんが言われるように、フォームコントロールをメニューシートの位置づけに利用するのであれば =以外、どのような方法があるのですか? 質問:フォームコントロールシートのデータを見積書に移すためには、=(式）は、壊れるのであれば見積書のシート上で色々なボタンを使ってやればいいのでしょうか? それとも他にいい方法がありますか? 時間をかけても（私自身ですが）過去のデータを呼び出したり新規登録をしたりする半平太さんのアイデアを行いたいので教えてください。半平太さんも私が理解不足なために細かくわかりやすく説明をしていただいているのにも関わらず半平太さんの意向に沿わず疲れていると思います。私も半平太さんのマクロで範囲をとらえ、合っていましたので、次の段階へとつなげると楽しみにしていましたが、正直なところ疲れが一度にでまして力が抜けました。でも負けません。長くなりましたが、なにとぞよろしくお願いいたします。（謙治） 2018/04/06(金) 17:34 ---- 何か話が噛み合わないですね・・と言うより、却って空中分解気味ですね。いままで「見積書シートのデータを保存する」と言う方向で進んでいたと思うんですが、「フォームコントロールシートのデータを保存する」と言うのが正しい考え方なんでしょうか? （半平太） 2018/04/06(金) 19:26 ---- 違いますよ。見積書シートのデータを保存するという方向ですよ、〉フォームコントロールシートは、データを見積書シートに反映させているだけです。（謙児） 2018/04/06(金) 19:39 ---- なら、根源データであるフォームコントロールのデータを保存して置けばいいハズです。そのデータがあれば、見積書は数式によって正しく反映されるんでしょう? 過去のデータを呼び出す時は、保存シートからフォームコントロールシートの方へ埋め戻すことになります。（半平太） 2018/04/06(金) 19:57 ---- 半平太さん今晩は、＞なら、根源データであるフォームコントロールのデータを保存して置けばいいハズです。その方法がありますね、見積書を印刷するとともに保存することを考えていましたからその考えが浮かばなかったです。＞そのデータがあれば、見積書は数式によって正しく反映されるんでしょう? その通りです。ありがとうございます。＞過去のデータを呼び出す時は、保存シートからフォームコントロールシートの方へ埋め戻すことに＞なります。それは、理解できます。埋め戻したら見積書に=によって反映しますから。マクロのコードで見積書からフォームコントロールに替えますがフォームコントロールシート名は長いので書きやすくするためにコントロールの"CON"にします。ゆえにシート名:CON です。質問: 1、シート名:CON の見積り内訳は1行づつ結合してもよろしいか? 2、B列からI列迄の列の数は、そのままでいいのですか? それともセルを標準に合わせて表を作りなおす方が、半平太さんがやり易いならそうします。（謙児） 2018/04/06(金) 22:20 ---- ＞シート名:CON 1.「CON」は全角ですか、半角ですか? ＞1、シート名:CON の見積り内訳は1行づつ結合してもよろしいか? ＞2、B列からI列迄の列の数は、そのままでいいのですか? ＞それともセルを標準に合わせて表を作りなおす方が、半平太さんがやり易いならそうします。そちらのやり易い方で決めてください。私としては、最終的なレイアウトを決めたら変更しないで欲しいと言うことだけです。 2.CONの最終レイアウトが決まったら、範囲全体の大きさを例の方法(下記）で調べて教えて下さい。 Sub getUsedRangeAdr() MsgBox Sheets("CON").UsedRange.Address(0, 0) End Sub その範囲に合わせて、「CONシート再現プログラム作成」マクロをこちらからアップします。（半平太） 2018/04/06(金) 22:48 ---- ＞最終的なレイアウトを決めたら変更しないで欲しいと言うことだけです。 ↑ その後、使い勝手の改善の為、わたしから変更の提案をします。「それまでの間」と言うことです。 (念の為）（半平太） 2018/04/06(金) 22:55 ---- 半平太さん、おはようございます。上記コメント理解しました。〉そちらのやり易い方で決めてください。時間を下さい。出来るだけ早くフォームを変更していきます。＞最終的なレイアウトを決めたら変更しないで欲しいこのためにも考えて作ります。（謙児） 2018/04/07(土) 07:31 ---- 〉「CON」は全角ですか、半角ですか? 忘れていました。小文字にします。（謙児） 2018/04/07(土) 07:39 ---- 半平太さん＞私としては、最終的なレイアウトを決めたら変更しないで欲しいと言うことだけです。と書いてありましたから今度こそご迷惑をかけられないと思い、昨日、見積書、納品書、請求書の発行を一番多い部長（当初、見積書の印刷物を見せてこれでいいですか?と聞いてOKをもらっていました。）に今後変更は出来ませんからこの印刷物をよく見てください。私の伝えている事に追加項目は、ありませんか? と聞きましたら見積内容の項目を1行増やしてほしいとだけ言われただけです。（一行増やしました。）ですから今、合間に続きをしていますが、シート名:con のフォームを整理して半平太さんに送った場合には、以後項目箇所の変更は、ありません。今、シート名:con をセル幅を標準にして不要なセルを削除しました。見積内容の幅は、結合しました。単価、数量の入力欄をシート名:フォームコントロールの時から17行分にそれぞれコントロールボタンを作っていましたから、列を削除したことによってフォームコントロールのボタン、コンボボックス(マクロでの位置の変更）及びスピンボタンの位置等の変更をしました。狭い行間での貼付け、正しいセル位置の再確認等目が疲れました。その折、ふと思ったのですが、見積書では、=の式を使っていたので保存するときに壊れるとなり半平太さんにシート名:con を保存元にと言われ道があったと喜んでいたのですが、うかつにもシート名:con の中にも計算式があったのです。下記の計算は、con にあるデータです。これは、計算しないと各合計が出ません。（con の範囲は、後日お伝えするとして当初、見積書の右下Y45からAE49にあります）ましてそのお見積合額金計AE49の数字28、554をお見積金額 ¥28,554（G18のここに=AE49としています。）（消費税含みます。）納品場所納期本見積有効期限支払い条件見積書の右下Y45からAE49にあります。が下記の表示です。数量,金額合計 37,770 割引 30% -11,331 小計 26,439 消費税 8% 2,115 お見積合額金計 28,554 色々知恵のない中で考えたのですが、con シートで計算式が入っている箇所をマクロの記録を使って同シート内のその項目近くに貼り付けをし貼付けした場所を保存の範囲にもってくる方法は、駄目でしょうか? （謙治） 2018/04/08(日) 22:16 ---- ＞うかつにもシート名:con の中にも計算式があったのです。計算式が存在するのはあり得ることで、それ自体は問題ありません。ただ、保存の対象には出来ない（一般論として）。・・と言うか、保存する必要自体が無いハズなんですよ（一般論として）。何故って、その数式に使われている生データの方を保存して置けば、数式が生きている限り、同じ値を算出してくれるからです。これが、見積と納品の途中で消費税が変わったなんてことになると、ちょっとややこしいことになります。 ※いまのところ、その話題に立ち入る予定はありませんが、ややこしいことになるだろう事は、ご理解いただけると思います。＞下記の計算は、con にあるデータです。これは、計算しないと各合計が出ません。（con の範囲は、後日＞お伝えするとして当初、見積書の右下Y45からAE49にあります）＞＞ましてそのお見積合額金計AE49の数字28、554を＞お見積金額 ¥28,554（G18のここに=AE49としています。）＞（消費税含みます。）＞納品場所＞納期＞本見積有効期限＞支払い条件＞見積書の右下Y45からAE49にあります。が下記の表示です。＞数量,金額合計 37,770 ＞割引 30% -11,331 ＞小計 26,439 ＞消費税 8% 2,115 ＞お見積合額金計 28,554 ＞色々知恵のない中で考えたのですが、con シートで計算式が入っている箇所をマクロの記録を＞使って同シート内のその項目近くに貼り付けをし貼付けした場所を保存の範囲にもってくる方法は、＞駄目でしょうか? conシートがこちらに無いと、ちょっと、状況が把握しにくいですが、上述の説明では対応できないことなんですか? つまり、生データさえ戻せば、自動的に計算される項目なんじゃないですか? どうしても、数式で出したものを値で保存する必要があるならやむを得ませんので、数式の復活工程を入れるのは考慮します。しかし、いつ復活させるのか、タイミングを計るのが難しく、厄介なことになりますよ。多分、印刷を終わった時なのだと思いますが、使う人が間違いなくその操作を行うかどうか凄く不安です。兎に角、こちらはconシートが目の前になければ、これ以上推測で語れません。（半平太） 2018/04/09(月) 00:18 ---- 半平太さんおはようございます。〉ただ、保存の対象には出来ない（一般論として）。〉・・と言うか、保存する必要自体が無いハズなんですよ（一般論として）。〉何故って、その数式に使われている生データの方を保存して置けば、〉数式が生きている限り、同じ値を算出してくれるからです、こんどは、本当に、理解しました。それまでは、半平太さんから途中に何回か同じことを言われていても、私は保存というのは、見積書シートの表示されている全てが保存になるという考えが捨てきれなかったのです。例えば、一つの見積書が出来ました。保存します。次に新しい見積書を作り、請求書まで作成した後で、前の見積書は、どんな内容だったかな? 金額いくらだったかな? というときに保存先で全て見れるのが、保存だと固守していました。ですから、その保存先には、元の表示を全てコピーして値の貼り付けをすれば出来るはずなのにと思っていました。今、その考えを捨てます。〉どうしても、数式で出したものを値で保存する必要があるならやむを得ませんので、数式の復活工程を入れるのは考慮し〉多分、印刷を終わった時なのだと思いますが、使う人が間違いなくその操作を行うかどうか凄く不安です。もう、数式のところは、保存しません。何回も同じ事を言わせてすみませんでした。出来るだけ早くconシートを作成します。（謙児） 2018/04/09(月) 07:05 ---- 参考までに、今こちらで考えているconシートの操作開始メニューを上げておきます。取引種類(左セル) 番号/名前操作説明 ↓ ↓ ↓ 新規新規照会番号を入力してから、左セル(ここでは「新規」と書かれているセル）を選択呼出(照会番号で) 照会番号を入力してから、左セルを選択呼出(取引先名で) 照会したい取引先名を入力してから、左セルを選択する。するとその上のセル、つまり「呼出（照会番号で）」の右セルに当該取引先の照会番号一覧が入力規則に入るので、その中から希望する照会番号をクリックしてから、左セルを選択呼出(一つ過去) 入力不要今表示されている取引先のもう一つ古い取引を見たい場合に左セルを選択呼出(一つあと) 入力不要今表示されている取引先のもうひとつ新しい取引を見たい場合に左セルを選択呼出(直前保存分) 入力不要今さっき保存した取引を再度呼び出したい時、左セルを選択保存入力不要今表示されている取引を保存したい時、左セルを選択取引種類の選択無効/有効取引種類のセル自体に変更を加えたい時は「無効」にする。通常は「有効」にしておき、上述の取引種類の操作開始トリガーにする。 ※まだ構想の段階です(作ってみて、不具合があれば構想自体を変えます）そちらから、何か希望・疑問点があれば書いてください。現時点で、こちらが問題点と思っているのは、 conシートがどうなっているのか分からないので、上のメニューをどこに配置するのがいいか読めない所です。（半平太） 2018/04/09(月) 10:49 ---- 自己レスです。＞呼出(取引先名で) 照会したい取引先名を入力してから、左セルを選択する。＞するとその上のセル、つまり「呼出（照会番号で）」の右セルに＞当該取引先の照会番号一覧が入力規則に入るので、＞その中から希望する照会番号をクリックしてから、左セルを選択上の2段階方式は、冗長だったです。取引先を入れたら、その客の最新版をすぐ表示した方が実務的ですね。（それより古いものが見たかったのであれば、そこから「呼出(一つ過去) 」を数回クリックして行けば済む）なので、下記の仕様へ変更した方がよさそう。呼出(取引先名で) 照会したい取引先名を入力してから、左セルを選択する。すると「その取引先の最新取引」が表示される。（半平太） 2018/04/09(月) 16:17 ---- 半平太さん色々考えて頂き有難うございます。今、見ました。連絡遅くなりましてすみません。〉※まだ構想の段階です(作ってみて、不具合があれば構想自体を変えます）〉そちらから、何か希望・疑問点があれば書いてください有難うございます。↑の操作メニューを見て、先々楽しみでございます。今のところ希望・疑問点は、ありません。明日は、休みで落ち着けますから進めて行きます。お待ち下さい。（謙児） 2018/04/09(月) 16:24 ---- 半平太さん今晩は、お待たせしました。＞2.CONの最終レイアウトが決まったら、範囲全体の大きさを例の方法(下記）で調べて教えて下さい。＞ Sub getUsedRangeAdr() MsgBox Sheets("CON").UsedRange.Address(0, 0) ＞ End Sub 範囲は、A1:U49 迄です。よろしくお願いいたします。（謙児） 2018/04/09(月) 23:01 ---- ＞A1:U49 少し、範囲が狭まったですね。ホッとします。 2018/04/03(火) 19:50 にアップしたものと同じプログラムで処理可能です。プログラム名だけ変更して置きましたので、それをもう一度使ってください。＞Public Sub 見積書再現プログラム作成() ↓ Public Sub con再現プログラム作成() （半平太） 2018/04/09(月) 23:51 ---- 半平太さんおはようございます。早速のお返事、有難うございます。下記に再現プログラムを貼り付けしますので、よろしくお願いいたします。 Private Sub onlyOnce() Rem ' Range("[コピー半平太さんセル幅標準con.xlsm]con!$A$1:$U$75").Clear Rem 結合状態を処理 Range("O5:P5").Merge Range("B14:C14").Merge Range("D14:G14").Merge Range("B26:M26").Merge Range("B27:M27").Merge Range("B28:M28").Merge Range("B29:M29").Merge Range("B30:M30").Merge Range("B31:M31").Merge Range("B32:M32").Merge Range("B33:M33").Merge Range("B34:M34").Merge Range("B35:M35").Merge Range("B36:M36").Merge Range("B37:M37").Merge Range("B38:M38").Merge Range("B39:M39").Merge Range("B40:M40").Merge Range("B41:M41").Merge Range("B42:M42").Merge Range("B43:M43").Merge Range("B44:M44").Merge Range("B46:L46").Merge Range("B47:L47").Merge Range("B48:L48").Merge Range("B49:L49").Merge Rem 数式セル以外をまとめて処理 Range("O4").Value = "照会番号と発行日" Range("O5").Value = 123456789 Range("B6").Value = "支払先名等" Range("O6,E20:E21").Value = "平成" Range("P6,F20:F21").Value = 30 Range("Q6,G20:G21").Value = "年" Range("R6,O30,N33").Value = 4 Range("S6,I20:I21").Value = "月" Range("T6,O34,N37").Value = 8 Range("U6,K20:K21").Value = "日" Range("B7").Value = "〒XXX-XXXX" Range("O7").Value = "担当" Range("B8").Value = "東京都新宿区" Range("O8").Value = "担当者 " Range("P8").Value = "営業部長 △△△" Range("B9").Value = "新宿第一ビル" Range("O9").Value = "E-mail" Range("B10").Value = "〇〇〇株式会社御中" Range("O10").Value = "xxxxxxxxxx" Range("B11").Value = "△△△様" Range("O12").Value = "担当部署" Range("O13").Value = "フロント" Range("B14").Value = "見積り金額" Range("B19").Value = "納品場所 " Range("E19").Value = "ご指定の場所" Range("B20").Value = "納期 " Range("H20:H21,O31,N34").Value = 5 Range("J20,O28,N31").Value = 2 Range("B21").Value = "本見積有効期限 " Range("J21").Value = 31 Range("B22").Value = "支払条件" Range("E22").Value = "納入月末締め、翌月末振込" Range("B25").Value = "明細" Range("B26").Value = "見積内訳" Range("N26").Value = "単価" Range("O26").Value = "数量" Range("P26").Value = "金額" Range("Q26").Value = "単価ボタン" Range("R26").Value = "数量ボタン" Range("B27").Value = "スタンディングヒップ" Range("N27,N29").Value = 720 Range("O27,N30").Value = 1 Range("B28").Value = " ボタンバルブ、止め金具、ネジセット 1式" Range("N28").Value = 1030 Range("B29").Value = "レッグエクステンション" Range("O29,N32").Value = 3 Range("B30,B33").Value = " シリンダーオーバーホール1式" Range("B31").Value = "※（分解、清掃、グリスアップ、シール類、パッキン類交換）あういえおかきくけ" Range("B32").Value = "ロウワーバック" Range("O32,N35").Value = 6 Range("O33,N36").Value = 7 Range("B34").Value = "※（分解、清掃、グリスアップ、シール類、パッキン類交換）" Range("B35").Value = " プロフェッサーボックス（ブラックボックス）" Range("O35,N38").Value = 9 Range("B36").Value = "パワーマックス konami" Range("O36,N39").Value = 10 Range("B37").Value = "ハンドルテープ、プラグセット" Range("O37,N40").Value = 11 Range("O38,N41").Value = 12 Range("B39").Value = "パット張替え（レザーが硬化劣化し、怪我をするレベル）" Range("O39,N42").Value = 13 Range("B40").Value = " レッグエクステンション・レッグカール1式" Range("O40,N43").Value = 14 Range("B41").Value = " ラットプル1式" Range("O41").Value = 15 Range("B42").Value = "※パット張替は、取り外し、持ち帰り、取付工期約5日" Range("O42").Value = 16 Range("B43").Value = "ASDF" Range("O43").Value = 17 Range("N44").Value = 1750 Range("O44").Value = 18 Range("N45").Value = "数量,金額合計" Range("B46").Value = "購入枚数が200枚以上の場合、20%の割引となります。" Range("N46").Value = 0.2 Range("N47").Value = "小計" Range("N48").Value = 0.08 Range("N49").Value = "お見積合額金計" Rem 数式セルをまとめて処理 Range("D14").FormulaR1C1Local = "=R[35]C[12]" Range("P27:P44").FormulaR1C1Local = "=IF(RC[-2]*RC[-1]=0,"""",RC[-2]*RC[-1])" Range("P45").FormulaR1C1Local = "=SUM(R[-18]C:R[-1]C[3])" Range("P46").FormulaR1C1Local = "=IF(ROUND(-R[-1]C*RC[-2],0)=0,"""",ROUND(-R[-1]C*RC[-2],0))" Range("P47").FormulaR1C1Local = "=SUM(R[-2]C:R[-1]C[3])" Range("P48").FormulaR1C1Local = "=IF(ROUND(R[-1]C*RC[-2],0)=0,"""",ROUND(R[-1]C*RC[-2],0))" Range("P49").FormulaR1C1Local = "=SUM(R[-2]C:R[-1]C)" Rem 標準外書式セルをまとめて処理 Range("H14:L18,D15:D18,F19:L19").NumberFormatLocal = "¥#,##0;¥-#,##0" Range("N27:N44,P27:S44,N45:S45,P46:S46,N47:S47,P48:S48,N49:S49").NumberFormatLocal = "#,##0;[赤]-#,##0" Range("N46:O46").NumberFormatLocal = """割引"" 0%;;" Range("N48").NumberFormatLocal = """消費税"" 0%;;" Rem 塗りつぶしセルをまとめて処理 Range("B1:U1").Interior.ColorIndex = 50 Range("O4:Q4,B6:C6,O7,O9:R9,O12:P12,B19:D22").Interior.ColorIndex = 20 Range("O5:P5,P6,R6,T6,B7:J11,P8:R8").Interior.ColorIndex = 40 Range("O10:R10,O13,E19:K22,B27:O44,Q27:R44,B46:L49").Interior.ColorIndex = 40 Range("D14:G14,P27:P49").Interior.ColorIndex = 6 Range("B26:R26").Interior.ColorIndex = 35 End Sub なお下記の範囲の色は、データ入力の見出しの色=20、データ入力の色=40、計算式が入っている色=6、単なる見出しの色=35と半平太さんにわかっていた出来やすいように識別し直しました。内、Q27:R44の範囲は、ボタン（Q=単価ボタン、R=数量ボタン）をつけている範囲です。 ' Rem 塗りつぶしセルをまとめて処理 Range("O4:Q4,B6:C6,O7,O9:R9,O12:P12,B19:D22").Interior.ColorIndex = 20 Range("O5:P5,P6,R6,T6,B7:J11,P8:R8").Interior.ColorIndex = 40 Range("O10:R10,O13,E19:K22,B27:O44,Q27:R44,B46:L49").Interior.ColorIndex = 40 Range("D14:G14,P27:P49").Interior.ColorIndex = 6 Range("B26:R26").Interior.ColorIndex = 35 どうぞ、よろしくお願いします。（謙児） 2018/04/10(火) 09:05 ---- ＞下記の範囲の色は、データ入力の見出しの色=20、データ入力の色=40、計算式が入っている色=6、＞単なる見出しの色=35と半平太さんにわかっていた出来やすいように識別し直しました。＞内、Q27:R44の範囲は、ボタン（Q=単価ボタン、R=数量ボタン）をつけている範囲です。この情報は助かりました。無いと、この確認だけで、数回やりとりが必要になったところです。 1.まず、こちらサイドの構想ですが、保存シートは2種類作ります。 1つは、今までの方針にそった「保存」シートです。(呼出に使う）あと1つは、「ダイジェスト」シートです。(取引先別の取引概要リスト作成に使う）呼出し用のデータではないので、数式セルも保存対象にします。それによって、いちいち呼出して計算結果を調べなくても合計金額などがダイレクトに把握できます。ダイジェストなので、細かい情報は保存しません。多分、取引先名、照会番号、日付、割引前、割引後、税込み後、進捗度(※) くらいでいいでしょう。今は思いもよらないリストかも知れませんが、後でこれが必要だと思うようになります。 (※)進捗度とは、見積段階を1、納品段階を2、請求段階を3、入金確認を4とかにする(A,B,Cでもその他有意義なものなら何でも可）なので、conシートにもこの進捗度を書き込む場所を確保する必要があります。この情報がないと、ダイジェストの有難味が半減します。このデータは保存シートにも書き込んで、呼出でも使用します。 2.保存範囲 (1)結合セルは左上のセルしか値を持たないので、保存範囲も左上セルだけに修正します。 (2)日付は「元号年月日の文字」は不要なので、数字部分だけとします。見積日付はそうなっていますが、納期と有効期限もそれに合わせます。 (3)単価・数量ボタンの下のエリアが保存対象になっているんですが、必要なんでしょうか? (4)合計の計算範囲が「単価・数量ボタン」範囲を含んでいますが、それは不要と思いますので変更が必要と思いますが? P45セル =SUM(P27:S44) → (正) P45セル =SUM(P27:P44) P47セル =SUM(P45:S46) → (正) P47セル =SUM(P45:P46) (5)進捗度の入力場所取りあえず、S4セルとします。不都合であれば言ってください。メニュー項目の追加も加味すると配置は下図になります。行 _________O_________ ________P________ _Q_ __R__ _S_ _T_ _U_ ________V________ ____W____ 4 照会番号と発行日 PrgNo 1 メニュー 5 123456789 番号/名前 6 平成 30 年 4 月 8 日新規 7 担当呼出(照会番号で) 8 担当者営業部長 △△△ 呼出(取引先名で) 9 E-mail 呼出(一つ過去) 入力不要 10 xxxxxxxxxx 呼出(一つあと) 入力不要 11 呼出(直前保存分) 入力不要 12 担当部署保存入力不要 13 フロント予備1 14 予備2 15 予備3 16 予備4 17 取引種類の選択無効/有効以下のマクロで保存範囲が合っているかご確認下さい。(「単価・数量ボタン」の下範囲は除いてあります） Sub 範囲確認() Range("O5,P6,R6,T6,B7:B11,P8,O10,O13,E19,F20,H20,J20,F21,H21,J21,E22,B27:B44,N27:N44,O27:O44,B46:B49,S4").Select End Sub 以上（半平太） 2018/04/10(火) 12:45 ---- 半平太さんこんにちは、＞「ダイジェスト」シートです。有り難い、アイデア、嬉しいです。＞2.保存範囲＞(1)結合セルは左上のセルしか値を持たないので、保存範囲も左上セルだけに修正します。はい、理解しました。 >2)日付は「元号年月日の文字」は不要なので、数字部分だけとします。 >見積日付はそうなっていますが、納期と有効期限もそれに合わせます。はい、有難うございます。すみません、見過ごしていました。 >(3)単価・数量ボタンの下のエリアが保存対象になっているんですが、必要なんでしょうか? 必要ありません。（単価、数量のところにボタンがあれば実際の数値が見えない為、Q列とR列にボタンを並べただけです。）＞(4)合計の計算範囲が「単価・数量ボタン」範囲を含んでいますが、それは不要と思いますので変更が必要＞と思いますが? ＞P45セル =SUM(P27:S44) → (正) P45セル =SUM(P27:P44) ＞P47セル =SUM(P45:S46) → (正) P47セル =SUM(P45:P46) なおしました。有難うございます。（色々確認していましたのに、何でS列迄入っていたのか、わかりません。）＞(5)進捗度の入力場所＞取りあえず、S4セルとします。不都合であれば言ってください。不都合では、ありません。ただ、S4セルということは、1から3行迄は、何か入っているのですか? ＞以下のマクロで保存範囲が合っているかご確認下さい。(「単価・数量ボタン」の下範囲は＞除いてあります）範囲は、合っています。色々考えて頂き有難うございました。よろしくお願いいたします。（謙児） 2018/04/10(火) 13:40 ---- ＞＞(5)進捗度の入力場所＞＞取りあえず、S4セルとします。不都合であれば言ってください。＞不都合では、ありません。ただ、S4セルということは、1から3行迄は、何か入っているのですか? いえ、そちらのレイアウトが4行目から始まっているので、目線を同じレベルに合わせました。 ※最上段が、4行目にある「照合番号と発効日」のタイトルだったので。以上で、レイアウトは確定といたします。次回レスまでしばらく時間が掛かります。 m(__)m （半平太） 2018/04/10(火) 15:00 ---- 半平太さん＞※最上段が、4行目にある「照合番号と発効日」のタイトルだったのでそうでたか? 合わせていただき有難うございました。＞次回レスまでしばらく時間が掛かります。 m(__)m 無理なさらずにお願いします。（謙児） 2018/04/10(火) 16:12 ---- 半平太さん今晩は、このコメントで書く事ではないかもしれませんが、明日の朝早くから夜までパソコンが使えませんので、急いでして頂かなくても結構ですよ。折角して頂いてもパソコンが触れなかったら申し訳ないですから。（謙児） 2018/04/10(火) 21:57 ---- 実際にテストしてみると、セルをクリックする方式はダメですね。矢印キーでも作動してしまい、実務には耐えられないです。なので、右クリックイベントにします。 1.最初に、conシートに進捗度とメニュー項目を追加してください。 conシートのシートモジュールをクリアにしてから、下のマクロ「onlyOnce」を貼り付けて実行。終わったら、Ctrlキー + Zキー（元に戻す）でマクロを消去。 Private Sub onlyOnce() Rem 生データのセルをまとめて処理 With Me .Range("R4").Value = "進捗度" .Range("V4").Value = "メニュー（右クリック）" .Range("W5").Value = "番号/名前" .Range("Y5").Value = "操作説明" .Range("V6").Value = "新規" .Range("Y6").Value = "新規照会番号を入力してから、左セルを右クリック" .Range("V7").Value = "呼出(照会番号で)" .Range("Y7").Value = "照会番号を入力してから、左セルを右クリック" .Range("V8").Value = "呼出(取引先名で)" .Range("Y8").Value = "照会したい取引先名を入力してから、左セルを右クリックするとその顧客の最新取引が呼び出される" .Range("V9").Value = "呼出(一つ過去)" .Range("W9:W10,W12").Value = "入力不要" .Range("Y9").Value = "今表示されている取引先のもう一つ古い取引を見たい場合に左セルを右クリック" .Range("V10").Value = "呼出(一つあと)" .Range("Y10").Value = "今表示されている取引先のもうひとつ新しい取引を見たい場合に左セルを右クリック" .Range("V11").Value = "呼出(直前保存分)" .Range("Y11").Value = "今さっき保存した取引を再度呼び出したい時、右クリック" .Range("V12").Value = "保存" .Range("Y12").Value = "今表示されている取引を保存したい時、右クリック" .Range("V14").Value = "予備1" .Range("V15").Value = "予備2" .Range("V16").Value = "予備3" End With With Sheets("保存") .Range("A2").value = "照合番号" .Range("H2").value = "取引先名" End With End Sub 2.シートを2枚追加「サブリスト」、「ダイジェスト」と命名してください。 3.ダイジェストシートの1行目のタイトルを以下のマクロ「onlyOnce」を使って書込み（上記1と同じ要領です） Private Sub onlyOnce() Rem 生データのセルをまとめて処理 With Me .Range("A1").Value = "取引先名" .Range("B1").Value = "照会番号" .Range("C1").Value = "発効日" .Range("D1").Value = "納期" .Range("E1").Value = "有効期限" .Range("F1").Value = "割引前" .Range("G1").Value = "小計" .Range("H1").Value = "税込金額" .Range("I1").Value = "進捗度" .Range("J1").Value = "内訳概要" End With End Sub 4.現在のconシートの名前定義を削除 Ctrlキー+F3でダイアログを出して、「保存範囲」と言う名前を削除してください。代わりに以下のコードでセル範囲を選択しその範囲を名前ボックスで「保存範囲」と命名してください。 Sub 範囲確認() Range("O5,P6,R6,T6,B7:B11,P8,O10,O13,E19,F20,H20,J20,F21,H21,J21,E22,B27:B44,N27:N44,O27:O44,B46:B49,S4").Select End Sub 上のコードも不要なので、Ctrlキー + Z で消去してください。 5.conシートのシートモジュールに書きプロシージャを貼り付け 'ここからーーーーーーーーーーーーーーーーーーーーーーーーーーーーー Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) Dim KEY, KEYS, i As Long Dim CustName If Target.CountLarge > 1 Then Exit Sub If Intersect(Range("V6:V12"), Target) Is Nothing Then Exit Sub Cancel = True Call 初期値設定 Rem 取引の種類に従って分岐する Select Case Target.Address(0, 0) Case "V6" ' 新規処理 →入力範囲をクリア→照会番号を入れてスタート If callable新規(Target) = False Then Exit Sub '事前チェック rngToClear.ClearContents '照会番号と進捗度は1をセット Range("S4").Value = 1 preProcCell.Value = "新規" refNoCell.Value = Range("W6").Value Range("W6").ClearContents refNoCell.Select coloring 1, 0, 0 Case "V7" ' 照会番号で呼出 If callable呼出指定(Target, "W7") = False Then Exit Sub '事前チェック KEY = Target.Offset(, 1).Value If 履歴呼出成否(KEY) = False Then Exit Sub '呼出不成功 '呼出成功。照会番号をクリア preProcCell.Value = "呼出" Range("W7").ClearContents refNoCell.Select coloring 2, 0, 0 Case "V8" ' 取引先名で呼出 If callable呼出指定(Target, "W8") = False Then Exit Sub '事前チェック CustName = Target.Offset(, 1).Value KEY = getCustKEYbyPos(CustName, refNoCell, "Latest") If KEY = CustName Then '最上段の取引先名になっている MsgBox "当該取引先は照合番号がありません。" Exit Sub ElseIf 履歴呼出成否(KEY) = False Then '呼出不成功 Exit Sub End If '呼出成功。取引先名をクリア Range("W8").ClearContents refNoCell.Select '照会番号のリストをセットする coloring 3, 0, 0 Case "V9" ' 呼出Older If callable呼出自動(Target, custNameCell) = False Then Exit Sub '事前チェック KEY = getCustKEYbyPos(custNameCell.Value, refNoCell.Value, "Backwards") If KEY = custNameCell.Value Then '最上段の取引先名になっている MsgBox "これ以上過去取引はありません。" Exit Sub End If If 履歴呼出成否(KEY) = False Then Exit Sub '呼出不成功 '呼出成功。照会番号をクリア preProcCell.Value = "呼出" refNoCell.Select coloring 4, 0, 0 Case "V10" ' 呼出Yanger If callable呼出自動(Target, custNameCell) = False Then Exit Sub '事前チェック KEY = getCustKEYbyPos(custNameCell.Value, refNoCell.Value, "Forwards") If KEY = Empty Then '最上段の取引先名になっている MsgBox "これ以上新しい取引はありません。" Exit Sub End If If 履歴呼出成否(KEY) = False Then Exit Sub '呼出不成功 '呼出成功。照会番号をクリア preProcCell.Value = "呼出" refNoCell.Select coloring 5, 0, 0 Case "V11" ' 呼出StoredJustBefore If callable呼出指定(Target, preRefCell.Value) = False Then Exit Sub '事前チェック KEY = Target.Offset(, 1).Value If 履歴呼出成否(KEY) = False Then Exit Sub '呼出不成功 '呼出成功。照会番号をクリア preProcCell.Value = "呼出" refNoCell.Select coloring 6, 0, 0 Case "V12" ' 保存 → If isSufficiantData = False Then Exit Sub ElseIf was保存Done = False Then Exit Sub End If Call was保存Digest 'ダイジェストにも書込み preRefCell.Value = refNoCell.Value preProcCell.ClearContents '保存したら前回処理名をクリアする rngToClear.ClearContents '入力データをクリアする coloring 7, 0, 0 End Select End Sub Function was保存Done() As Boolean Dim cel As Range Dim COL As Long Dim ValToFil() As Variant Dim Rw As Variant Dim msg As String Dim KEY KEY = refNoCell.Value '照合番号 Rw = RwNum(KEY, WshDEST, 保.照番) If IsNumeric(Rw) Then 'KEYが存在する→上書き保存しかない If preProcCell.Value = "新規" Then '矛盾 MsgBox "その照会番号は、既に存在しています。新規ではありません" Exit Function Else msg = "上書き保存しました" 'メッセージを先にセットする End If Else '新規 msg = "新規保存しました" Rw = WshDEST.Cells(WshDEST.Rows.Count, "A").End(xlUp).Row + 1 End If ReDim ValToFil(1 To 1, 1 To rngToStore.Cells.Count) COL = 0 For Each cel In rngToStore COL = COL + 1 ValToFil(1, COL) = cel.Value Next WshDEST.Cells(Rw, 1).Resize(1, rngToStore.Cells.Count).Value = ValToFil was保存Done = True MsgBox msg End Function Private Sub coloring(first As Long, second As Long, third As Long) Application.ScreenUpdating = False With Range("V6:V12") .Cells.Interior.Color = 65535 If first Then .Cells(first, 1).Interior.Color = 11851260 If second Then .Cells(second, 1).Interior.Color = 11851260 If third Then .Cells(third, 1).Interior.Color = 11851260 End With Application.ScreenUpdating = True End Sub Function was保存Digest() As Boolean Dim cel As Range Dim COL As Long Dim ValToFil() As Variant Dim Rw As Variant Dim msg As String Dim KEY KEY = refNoCell.Value '照合番号 Rw = RwNum(KEY, WshCmp, 2) If Not IsNumeric(Rw) Then Rw = WshCmp.Cells(WshCmp.Rows.Count, "A").End(xlUp).Row + 1 End If ReDim ValToFil(1 To 1, 1 To 10) With WshSRC ValToFil(1, 1) = custNameCell ValToFil(1, 2) = refNoCell ValToFil(1, 3) = DateRemade(.Range("O6:U6")) ValToFil(1, 4) = DateRemade(.Range("E20:K20")) ValToFil(1, 5) = DateRemade(.Range("E21:K21")) ValToFil(1, 6) = .Range("P45") ValToFil(1, 7) = .Range("P47") ValToFil(1, 8) = .Range("P49") ValToFil(1, 9) = .Range("S4") ValToFil(1, 10) = .Range("B27") & " 等" End With WshCmp.Cells(Rw, 1).Resize(1, 10).Value = ValToFil was保存Digest = True End Function Function DateRemade(ByRef rSource As Range) Dim str, cel As Range For Each cel In rSource str = str & cel.Value Next On Error Resume Next DateRemade = CDate(str) On Error GoTo 0 End Function 'ここまで ------------------------------ 6.標準モジュール1(「module1」→「事前チェックにモジュール名を変更」) ※変更しなくても影響はありません。 'ここから=============================== Function isPreNewOK() As Boolean If preProcCell.Value = "新規" Then '新規処理中で、保存前に新たな処理が要求された If MsgBox("入力済データはクリアされます。" & "よろしいですね?", vbOKCancel) = vbCancel Then Exit Function End If End If isPreNewOK = True End Function Function callable新規(ByRef Target As Range) As Boolean Dim KEY If isPreNewOK = False Then Exit Function KEY = Target.Offset(, 1).Value If IsEmpty(KEY) Then MsgBox "W6セルに新しい照会番号を入れてください" Exit Function ElseIf numMatches(WshDEST, 保.照番, KEY) > 0 Then MsgBox "その照会番号は既に存在します" Exit Function End If callable新規 = True End Function Function callable呼出指定(ByRef Target As Range, ByVal strAdrToFil) As Boolean Dim KEY If isPreNewOK = False Then Exit Function KEY = Target.Offset(, 1).Value If IsEmpty(KEY) Then MsgBox strAdrToFil & "セルに照会番号・取引先名を入れてください" Exit Function End If callable呼出指定 = True End Function Function callable呼出自動(ByRef Target As Range, ByVal rngrToCheck As Range) As Boolean Dim KEY If isPreNewOK = False Then Exit Function KEY = rngrToCheck.Value If IsEmpty(KEY) Then MsgBox rngrToCheck.Address(0, 0) & "セルにデータがありません" Exit Function End If callable呼出自動 = True End Function 'ここまで=================================== 7.標準モジュール2(「module1」→「共通」にモジュール名を変更」) ※変更しなくても影響はありません。 'ここからーーーーーーーーーーーーーーーーーーーーーーーーーーーーー Public Enum 保 'WshDEST 照番 = 1 取引先番 = 8 End Enum Public Enum サブ照番 = 1 取引先番 = 2 個別照番 = 3 End Enum Public WshSRC As Worksheet 'CON Public WshDEST As Worksheet '保存 Public WshSLT As Worksheet 'サブリスト Public WshCmp As Worksheet 'ダイジェスト Public rngToStore As Range Public rngToClear As Range Public TopRightCell As Range Public preProcCell As Range '前回処理名のセル Public refNoCell As Range Public custNameCell As Range Public preRefCell As Range Sub 初期値設定() Dim clearScope As String Set WshSRC = Sheets("CON") Set WshDEST = Sheets("保存") Set WshSLT = Sheets("サブリスト") Set WshCmp = Sheets("ダイジェスト") Set rngToStore = WshSRC.Range("保存範囲") Set TopRightCell = WshDEST.Range("A1", WshDEST.Cells(1, 10000).End(xlToLeft)) Set preProcCell = WshSRC.Range("V5") Set preRefCell = WshSRC.Range("W11") 'クリアする時は、結合セルの情報が必要 clearScope = "O5:P5,P6,R6,T6,B7:B11,P8,O10,O13,E19,F20,H20,J20," & _ "F21,H21,J21,E22,B27:M44,N27:N44,O27:O44,B46:L49,S4" Set rngToClear = WshSRC.Range(clearScope) Set refNoCell = WshSRC.Range("O5") Set custNameCell = WshSRC.Range("B10") End Sub '1列内に存在する位置 Function RwNum(ByVal KEY, ByRef TargetWsh As Worksheet, ByVal 列 As Long) As Variant RwNum = Application.Match(KEY, TargetWsh.UsedRange.Columns(列), 0) End Function '1列内に存在する数 Function numMatches(TargetWsh As Worksheet, ByVal 列, ByVal KEYToCheck) As Variant numMatches = Application.CountIf(TargetWsh.UsedRange.Columns(列), KEYToCheck) If KEYToCheck = TargetWsh.UsedRange.Cells(1, 1) Then 'タイトル行と合致してしまった numMatches = 0 End If End Function Function 履歴呼出成否(ByVal KEY) As Boolean Dim Rw Dim cel As Range Dim ValToBack 履歴呼出成否 = True Select Case numMatches(WshDEST, 保.照番, KEY) Case 0 MsgBox "当該照合番号は存在しません" 履歴呼出成否 = False Exit Function Case Is > 1 MsgBox "当該照合番号が保存シートに重複しています。原因を調査してください。" 履歴呼出成否 = False Exit Function Case Else '1個のみ該当 Rw = RwNum(KEY, WshDEST, 保.照番) If preProcCell.Value = "新規" Then '前回が新規で保存していない履歴呼出成否 = False End If Application.ScreenUpdating ...; http://www.excel.studio-kazu.jp/wiki/kazuwiki/201803/20180331225641.txt - [detail] - similar

PREV NEXT

訪問者：カウンタ