[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『見積書・納品書・請求書の追加作成』（謙児）
お世話になっています。
ファイル名：ＡＢＣ の中に
３つのシートがあります。シート名：各見積書、納品書、請求書です。
それぞれ見積書・納品書・請求書の明細が書かれています。
私としては、３つの各シート上で見積り書、納品書、請求書の追加データ
発行をしたいと思っています。、
（追加がある度にファイル名を変えずにファイル名：ＡＢＣの中で行いたいのです。）
しかし下記の理由によりうまく行きません。
何か良いアイデアを教えて頂けませんか？
例えば、Ａ業者からの依頼で、見積書から納品書・請求書迄発行します。
支払先名、他、明細内容は、同じです。
違うのは、見積り、納品、請求等の依頼文です。
従って見積書のデータを主に、納品書の支払先名、明細内容等の各項目データ
＝見積書の同項目セル番地として見積書と同じデータを表示しています。
請求書もしかりです。
うまく行かないのは、例えば、
Ａ業者の見積書を作成して相手に送付、返事待ち、その時に、
Ｂ業者の依頼で違う見積書を作成しました。
当然Ａ業者の納品書は、見積書の各項目データを＝で指定していますので、
見積書がＢ業者のデータになる為にＡ業者の納品書のデータは、Ｂ業者の
見積書データに変わります。
いつもお世話ばかりかけますが、よろしくお願いいたします。
＜ 使用 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
もう少しシステムチックに考えるにしても、
受注履歴を蓄積するデータベースがあって、印刷したい受注番号を入力や選択すると、
データを呼び出してくるみたいなシステムを組むんじゃないかなぁとおもいます
（もこな２） 2018/04/01(日) 00:31
もこな２様、
お返事有難うございます。
〉なんで１ファイルで全部処理する必要があるんでしょうか
数日前に教えて頂いた、請求書の最大件数の保存転記をそのまま
いかしています。(連続番号を用いて）
おかげさまで請求書の転記が出来ましたから、見積書並びに納品書も
別々のシートに転記をしました。
一つのファイルにこだわったのは、使う人が、見積書・納品書・
請求書の過去からのデータを連続番号を使って残しておきたかったからです。
(勿論、一件のデータ毎に別ファイルをすれば、簡単な
ことは、よくわかっていますよ。それでは、過去からの
データを連続番号を使って管理するのが、
難しいと思ったからです。）
〉受注履歴を蓄積するデータベースがあって、印刷したい受注番号を入力や選択すると、
〉データを呼び出してくるみたいなシステムを組むんじゃないかなぁとおもいます
まさにそういうことをしたかったのです。が
思いつかなかったのです。
ただ、私が作成している手順は、
見積書のフォームに、データを入れます。
そのデータを保存先に転記しています。
ですから、一件一件のデータを１行毎に入れてから、フォームに入れては、
いませんので、受注履歴を蓄積するデータベースを
作成して印刷したい受注番号を呼び出してくる
には、どのようにしたらいいかアタマが働きません。
教えて頂けますでしようか？
（謙児） 2018/04/01(日) 06:06
その時に、連続番号でデータを管理するファイルを別に作ろうと思います。
ファイル名：データ管理 シート名：保存
ここから質問です。
以前に教わり解決しましたＶＢＡのコードの中で、別ファイルの、ファイル名：データ管理 シート
名：保存 に転記するためには、下記コードのどこをどのように直せば宜しいかお伺いします。
なお、元の見積書等のファイル名は、追加があれば名前を付けて保存になりますので、ファイル名が
追加毎に任意で変わります。
ファイル名が変わっても、ファイル名：データ管理 シート名：保存 に転記されるようなコードを
教えて頂けますでしょうか？
（さっきネットでブックを開くには、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
'１０８行から１１６行迄は、合計金額等のデータで必ず入ります。
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会社の返事が来た) 保存したデータを呼び出して見積書を再構成する。 すると数式により納品書が自動的に出来上がる →納品書を印刷する ※できれば、納品書作成段階まで進んだ旨のデータを追加して上書き保存する ーーーーーーーーーーーーー
修正したい時も同様に、見積書を再構成してから、修正・保存を行えばよし。 ーーーーーーーーーーーーー
懸案事項として １．見積書のフォーム(様式）は十分に固まっているか。 様式変更は面倒な問題を惹起します。 どれだけ、将来の様式変更に対応できるように作る必要があるか、見極める必要があります。 「絶対に変更ない」との前提でよければ凄く楽になります。
２．保存データを呼び出す手掛かり(キーと呼ばれるもの）をどう構成するか。 会社名だけでは、何件もあるデータの中から特定することは出来ない。
通常は、会社名+見積日付 が最短キーになるかと思いますが、果たしてそれでいいのかどうか。 機械処理的には、見積書NO(ダブりがないもの）をキーにする方がいいのですけども・・
因みに、現在の方式では、どんな方法でマクロを実行させているんですか？ どこかに実行ボタンが作ってあって、それをクリックする方式？ もしその方式なら、呼び出しボタンも一つ追加する必要があります。
（半平太） 2018/04/01(日) 10:28
〉そのアイデアを捨て進めてしまい、現在に至って頓挫している、と言う状況ですよね？
もうとう捨てる気はないのですが、時間が時間がたっても
お返事がないので、私が具体的に示さないためかなあ
と思って別途ファイルを作り…と考案しました。
〉A会社の見積書を作る→印刷する→1行保存をする の
何行かは、私が望んでいることです。
懸案事項、落ち着いて精査してみます。
〉因みに、現在の方式では、どんな方法でマクロを実行させているのですか？
いまは、コードを出して実行しています、
勿論、他の人に使って頂くときには、ボタンを使用します。
回答者の方に２度手間をかけないように、仕事の合間をぬって少し考えます。
有難うございました。また連絡します。
（謙児） 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 ってそれぞれ入力してみて動きを確認してみてください。
（もこな２） 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)),"""")"
（もこな２） 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キーを押しながら）全部選択して、名前ボックスに「保存範囲」とでも命名するものとします。
１．保存シートにあらかじめタイトルを書き出します。 下記マクロ（タイトルとアドレス書出）を使って、一回だけ実行します。 ※このマクロは、様式に変更が無い限り、これで用済みです。
<保存>シートはこんなタイトルになります。(2行書き)
行 _A_ ______B______ ____C____ __D__ ___E___ __F__ __G__ __H__ 1 A3 B3 B6 C6 D6 E6 B7 2 KEY 得意先コード 得意先名 日付 商品名 単価 数量 金額
２．次からが日常処理です。 （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
＞うまく行かないのは、例えば、
＞Ａ業者の見積書を作成して相手に送付、返事待ち、その時に、
＞Ｂ業者の依頼で違う見積書を作成しました。
＞当然Ａ業者の納品書は、見積書の各項目データを＝で指定していますので、
＞見積書がＢ業者のデータになる為にＡ業者の納品書のデータは、Ｂ業者の
＞見積書データに変わります。
マクロとデータを別のファイルで管理したほうがよさそうに思えます。
マクロのあるファイルから、
各見積書ファイルを開いて操作すればよいです。
各ファイルの元の雛型ファイルは、テンプレート形式で保存しておきます。
テンプレートファイルというのは開くたびにコピーが新しく開きます。
保存は新規で保存しますので、上書きはされません。名前を同じだと上書きになりますが。
そうすることで、入力するたびに前前回のものが残ってないということは避けられます。
出来れば、それを発展させて、１件１行に集積していけばさらに良いのは他の方の説明の通りです。
なにより１件１行というのはエクセルが想定している型なので、
そうすることでエクセルの様々な機能を利用できます。
すでにある機能を利用できるということは自分で開発する必要がないということです。
つまり、今ある機能を再利用することで開発が簡素で容易になる利点あります。
独自の様式で全部自分で開発するなら、いかようにでもなるでしょうが、
複雑になり開発に時間がかかるのでお勧めではありません。
１行一件というのは見積書１枚ではなく各個々のデータです。
１枚の見積書は見積書番号で管理すればよいでしょう。
そうすることで、見積書の雛型に見積書が再現できるようになります。
マクロを使えば、瞬時に再現させられるので、見積書１枚１枚毎に保存する必要がなくなりますが、
まずは１枚１枚をファイルにしてそれを管理するところからマクロに慣れてはいかがでしょうか？
今までは、自ブックというのをなんとなく意識しなかったでしょうが、
どのブックかという記述を追加するだけで、
改変はそんなにはないと思います。
（まっつわん） 2018/04/01(日) 14:50
（今、落ち着きましたので、もこな様にアップしようとしましたら、
半平太さまからとまっつあん様から、たくさんのコメント（実例を含み）を有難うございます。
今から見させて頂き実行していきます。）
もこな様の上記コードを実行し動きはわかりました。ルックアップを利用してこのような事が
出来る、素晴らしいと思いました。
＞受注履歴を蓄積するデータベースがあって、印刷したい受注番号を入力や選択すると、
＞データを呼び出してくるみたいなシステムを組むんじゃないかなぁとおもいます
この考え方は、各項目のデータを１行に入力した後で、見積書のフォームに組み込む
という流れでしょうか？
そうであれば、下記のコードのように印刷するデータ範囲をコードの中にいちいち入れないと
行けないのでしょうか？
それよりも印刷する見積書の各項目にどうやって転記されるのでしょうか？
よろしくお願いいたします。
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使わなくてもできますよね？って言いたくて、例を提示しただけのつもりなんですが。。。
まぁコードの動きがわかったのであれば、今回のご質問とは関係ないということもわかると思うんですっぱり忘れてください。
とりあえず、いろんな人からのアドバイスを全部やろうとするとこんがらがってしまうので、どのアイデアを採用するのかを自分できちっときめて、そのうえで分からない部分を聞くようにしたらいいんじゃないでしょうか？
現状だと、
まったくわからないのでアイデア募集
↓
複数のアイデアが寄せられる
↓
すべてのアイデアをごちゃまぜにしてわからなくなる ←いまココ
のように思います。
（もこな２） 2018/04/01(日) 19:49
＞とりあえず、いろんな人からのアドバイスを全部やろうとするとこんがらがってしまうので、どのアイデア＞を採用するのかを自分できちっときめて、そのうえで分からない部分を聞くようにしたらいいんじゃないで＞しょうか？
＞すべてのアイデアをごちゃまぜにしてわからなくなる ←いまココ
＞のように思います。
その通りです。コメント、有難うございます。
私は、今回だけでなく、いつも各回答者が時間をさいて一生懸命に説明しておられるのに、ある回答者の説明
がわかりやすいと思ってその人にだけ進んで行くのは、他の人に対して失礼といつも思っています。
（でも言われるように私がいろいろな回答者から説明を受けてそれぞれ理解できる能力であれば
問題ないと思いますが、そうでありませんから。）
でもこれで思い切って今後、複数の回答者から説明を受けても、どのアイデアを採用するかを自分で決めていきます。
もこな２様以外の回答者の皆様も採用できない場合には、失礼と思いますがお許しください。
半平太様のＶＢＡ明日午後から始めます。
有難うございます。
（謙治） 2018/04/01(日) 21:51
私も半平太様のようにうまく出来ませんでしたが、具体的に、実際のデータを下記のように作成しました。
アルファベットの文字は、列を表します。
xxからxx と記載しているのは、セルを結合したものです。列幅は、１０以下の為たくさんの列が
あります。
ＶＢＡの保存を実行するとうまく行きません。
下記は、"新規保存しました"のまとめですが、見積書の最初にあるデータ、住所・名前が３行目のかなり
左の列に表示されています。？？ セル幅が１０以下で余白が出来ているためにずれていくのでしょうか？
私も明日、時間を見つけて確認をしてみます。ご指導お願いします。
a列 b列 c列 d e f g h -----
１行 ＡＣ５ ＡＣ６ B7 Ｂ８ Ｂ９ Ｂ１０ Ｂ１１ -----
２行 KEY 照会番号 発行日 〒 住所１ 住所２ 相手先名１ 相手先名２ -----
３行 -19000100
Ｂ３０ Y３０ ＡＣ３０ ＡＥ３０ Ｂ３１ Y３１ ＡＣ３１ ＡＥ３１ Ｂ３２ Y３２ ＡＣ３２ ＡＥ３２
見積内訳 単価 数量 金額 見積内訳 単価 数量 金額 見積内訳 単価 数量 金額
東京都新宿区 新宿第一ビル
＞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 〒ＸＸＸ-ＸＸＸＸ 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 から ｘ y からab acからad aeからai 26 見 積 内 訳 単 価 数量 金 額 27 ＸＸ機械 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
先ほど会社に付きました。
＞Sub getUsedRangeAdr()
＞ MsgBox Sheets("見積書").UsedRange.Address(0, 0)
＞ End Sub
見積表シートのデータ範囲（※）を教えて下さい。
範囲は、b1:ai52 です。よろしくお願いいたします。
このＭsgＢox、便利ですね。
（最後の列ai52は、当初ajでしたが照会番号と発行日のみが結合していましたので、結合しなおしaiに
しました。）
半平太様がこれから補強に入られる為、私が誤りか誤りでないかわかりませんが、半平太様にお伝えしな いと時間をかけていただくにとどまるかわかりませんので、下記にお伝えします。
１、＞数式が入っているところは非対象) その範囲を(Ctrlキーを押しながら）全部選択して、
＞名前ボックスに「保存範囲」とでも命名するものとします。
言われるように範囲を指定しました。名前ボックスは、「保存範囲」。
２、見積書のデータは、別のシート名：フォームコントロール（フォームコントロールのボタン、及び、
コントロールの書式設定でリンクするセル等を選びます。）等で選ぶようにしています。
したがって見積書の各データ項目は、例えば、照会番号を入力するＡＣ５には、=フォームコントロー
ル！ＡＣ５ を入れています。
３、＞下記、マクロは、１回目だけという事で
＞Sub タイトルとアドレス書出() '一回実行すればよし
.Value = [{"KEY"、"照会番号"、----でコントロールで範囲を決めた順に照会番号、発行日
etcを記載しまして保存を実行しましたが、貼付順番がバラバラの為に、範囲の選定に誤りがあるかと
思い範囲の指定を変えるとともに、
コードで名称を最初から変えていくのが面倒なために、
シート名：保存 の１行目と２行目は、自分でセル番地と項目名を手入力しました。
ただ、範囲の設定の中で、順番がわからないのは、見積内訳のＢ２７からＢ４３迄選択、次に単価
Ｙ２７行目から４３行目まで選択、次に数量ＡＣ２７行目から４３行目迄選択、
次に金額ＡＥ２７行目からＡＥ４３行目を選択の順番でいいのでしょうか？
それとも範囲の順番は、見積内訳のＢ２７、次に単価のＹ２７、数量のＡＣ２７、金額のＡＥ２７、
次に見積内訳のＢ２８、単価のＹ２８、数量のＡＣ２７、金額のＡＥ２８ のように
横列に進み次の行にいき見積内訳から金額迄行ってまた次の行と繰り返していく方法が良いのでしょうか
私は、後者の方を取り入れました。
見積内訳の列は、Ｂ２７からＸ２７までです。が、名前ボックスの保存範囲は、Ｂ列だけです。
（ここが、セルの結合をしなければならないかがわかりません。）
以上ですが、なかなか思ったことを文章化出来ません。
ご配慮のほど、よろしくお願いいたします。
数量の金額もそれぞれ２７行目から４３行目
見積内訳の行を順番に下の行にまず見積内訳ですが、
見積内訳は、Ｂ２７から下にＢ４３迄の範囲を選択、次に単価は、Ｙ２７からＹ４３迄の範囲を選択、
数量は、ＡＣ２７からＡＣ４３迄の範囲を選択、金額は、ＡＥ２７からＡＥ４３までの範囲を
選択となります。
Ａ列 Ｂ列 Ｃ列 Ｄ列
ＡＣ５ ＡＣ６ 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. その「照会番号」をキーとしていいんでしょうか？（本当に存在するデータなのですか？）
※キーとは、重複が無く、それだけで他の取引と区別できるデータ
＞貼付順番がバラバラの為に、範囲の選定に誤りがあるかと ＞思い範囲の指定を変えるとともに、
貼り付け順序をどうするかはマクロに任せます。人間が見るものでもないので・・ ・・と言っても見に行っちゃうのが人情でしょうね。
人間が見に行った時、人間が分かり易い順序である方がいいに決まっていますが、 余りこだわると本質を見失います。
保存シートはあくまで機械が処理する為にデータを格納している倉庫に過ぎません。 機械が間違いなく情報の出し入れができるなら、最低条件は満たされています。
＞シート名：保存 の１行目と２行目は、自分でセル番地と項目名を手入力しました。
機械にとっては１行目が重要で、2行目は何の意味もないです。（A2に「KEY」が入っていることだけは処理上、意味があります） 1行目に書かれるセルアドレスを見て見積書の再現を正しく行うことが出来ることになります。
＞見積内訳の列は、Ｂ２７からＸ２７までです。が、名前ボックスの保存範囲は、Ｂ列だけです。
Q2. ここの部分がちょっと分からないです。
上の方で、AC5とかAC6とかあったと思うんですけど、そこをご自分で書いたのですか？（機械に任せないと食い違いが起きます）
B列だけが保存範囲なら「B○」にしかならないハズです。
↓
＞１行 ＡＣ５ ＡＣ６ B7 Ｂ８ Ｂ９ Ｂ１０ Ｂ１１ -----
＞２行 KEY 照会番号 発行日 〒 住所１ 住所２ 相手先名１ 相手先名２ -----
＞３行 -19000100
＞Ｂ３０ Y３０ ＡＣ３０ ＡＥ３０ Ｂ３１ Y３１ ＡＣ３１ ＡＥ３１ Ｂ３２ Y３２ ＡＣ３２ ＡＥ３２
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
見積書シートをこちらで再現するため、以下の方法を使います。
そちらの作業 １．現物ファイルのコピーを作成する（このブックをお互いの共通認識ブックに仕立て、話に食い違いをなくさせる） ２．見積書シート上の重要情報は、無難なものに書き換える（消去はしないでください。手掛かりが無くなっちゃいます） ３．長い文字列は簡単な表現に換える
４．上記準備が整ったら、後記の「見積書再現プログラム作成」マクロを実行してください。
下記<プログラム実行手順>をご参照
５．上記４の結果、所期のプログラムコードが作成され、それがクリップボードに自動的に記憶されます。
その状態をキープしたまま（つまり、何か余計なことをやらないで）、 この掲示板の「コメント返信」ボックス内を右クリックして、貼り付ける。
６．コードの中に重要情報が書き出されていないことを再確認してからアップする。 万一、存在していたら、上記２からやり直してください。
当方は、アップされたプログラムコードを実行して、そちらと同じ見積書シートを再現します。
<プログラム実行手順>
見積書シートの「シート見出し」を右クリックして、「コードの表示(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セルからじゃないんですか・・、ちょっと不思議。
Ａ列は、印刷時に余白の調整をするために作っただけです。
＞ しかも見積書としては、尋常じゃなく広範囲ですね。
＞結合セルが多いセイなんですかねぇ。
最初、年月日を 年 月 日の数値をコントロールボタンを使って選ぶ為、あるいは、、
配置の項目によっては、表の上の方と下の方とでは、セル幅の位置に違いあるので、
細かいセルを作りました。（これが完成しましたらセル幅を少なくしてやりかえようかと
思っています。）
＞yからab（結合）acからaj（結合） ＞照会番号 1234568 ＞発行日 2018/4/1 ＞ Q1. その「照会番号」をキーとしていいんでしょうか？（本当に存在するデータなのですか？） はい、本当に存在するデータです。一つの取引で、見積書と納品書と請求書を同じ番号にします。
＞貼付順番がバラバラの為に、範囲の選定に誤りがあるかと ＞思い範囲の指定を変えるとともに、 保存を実行しましたら、一部ですが、下記のように誤った結果になりましたので、範囲の選定にあやまりが、 あるかと思い‐‐‐と記載しました。 Ｑ列 Ｙ列 １行 Ｂ２８ Ｂ３０ ２行 見積内訳 見積内訳 ３行 郵便番号 住所 正しいのは、郵便番号の位置は、Ｄ列の一行目がＢ７です。住所の位置は、Ｅ列の１行目がＢ８です。
＞シート名：保存 の１行目と２行目は、自分でセル番地と項目名を手入力しました。
＞見積内訳の列は、Ｂ２７からＸ２７までです。が、名前ボックスの保存範囲は、Ｂ列だけです。 Q2. ここの部分がちょっと分からないです。 これは、Ｂ２７からＸ２７迄を結合して保存範囲にしたのではなくＢ列２７だけを範囲としました ということです。
上の方で、AC5とかAC6とかあったと思うんですけど、そこをご自分で書いたのですか？（機械に任せないと食い違いが起きます） はい自分で書きました。それは、照会番号のデータがＡＣ５にあり、発行日のデータがＡＣ６にあるので 書きました。 １行目は、データのセルではないのですか？
とりわけここまで先にアップします。
今から、
＞見積書シートをこちらで再現するため、以下の方法を使います。
を実行してまいります。
（謙児） 2018/04/03(火) 23:39
下記の文章は、コメントではないので、書く必要は、
ないかもしれませんが、私からの返信が下記理由により
遅くなりましたら、半平太さんの方で上手くいっていないのかなあと
再度調べられては申し訳ないので、記載しました。悪しからず。
〉今から見積書シートをこちらで再現するため、以下の方法を使います。
を昨夜しようと思ったのですが、2・3、日前から目が痛く止めてしまいました。
今日は、色々な会議が続きます。折角色々、精査して頂いていますのに
申し訳なく思います。すみません。
（謙児） 2018/04/04(水) 09:25
＞上手くいっていないのかなあと
お気遣いは無用です。
心配のネタとしては、結合セルが大量にあるかも知れない点だけです。 昔、作ったプログラムなので、大量の結合セルをどこまで許容する作りにしたか、もう忘れています。
いずれにしても、そちらの結果レスが入ってから検討に入ります。
（半平太） 2018/04/04(水) 10:21
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 = "〒ＸＸＸ-ＸＸＸＸ"
Range("B8,Y9").Value = "東京都新宿区"
Range("B9,Y10").Value = "新宿第一ビル"
Range("B10").Value = "〇〇〇〇〇 株式会社 御中 "
Range("B11,Y12").Value = "△△△△様"
Range("Y11").Value = "〇〇〇〇〇 株式会社"
Range("Y13").Value = "担当 ：ｘｘｘｘ ｘｘｘｘ"
Range("B14").Value = "この度は弊社に見積の機会をお与えくださいまして誠に"
Range("Y14").Value = "Ｅ−ｍａｉｌ： "
Range("AB14").Value = "ｘｘｘｘｘｘｘｘ"
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 = "Ａ機械"
Range("Y27").Value = 100000
Range("AC27").Value = 1
Range("B28").Value = "Ｂ機械"
Range("Y28").Value = 101000
Range("AC28").Value = 2
Range("B29").Value = "Ｃ機械"
Range("Y29").Value = 102000
Range("AC29").Value = 3
Range("B30").Value = "Ｄ機械"
Range("Y30").Value = 103000
Range("AC30").Value = 4
Range("B31").Value = "Ｅ機械"
Range("Y31").Value = 104000
Range("AC31").Value = 5
Range("B32").Value = "Ｆ機械"
Range("Y32").Value = 107000
Range("AC32").Value = 6
Range("B33").Value = "Ｇ機械"
Range("Y33").Value = 108000
Range("AC33").Value = 7
Range("B34").Value = "Ｈ機械"
Range("Y34").Value = 109000
Range("AC34").Value = 8
Range("B35").Value = "Ｉ機械"
Range("Y35").Value = 110000
Range("AC35").Value = 9
Range("B36").Value = "Ｊ機械"
Range("Y36").Value = 111000
Range("AC36").Value = 10
Range("B37").Value = "Ｋ機械"
Range("Y37").Value = 112000
Range("AC37").Value = 11
Range("B38").Value = "Ｌ機械"
Range("Y38").Value = 113000
Range("AC38").Value = 12
Range("B39").Value = "Ｍ機械"
Range("Y39").Value = 114000
Range("AC39").Value = 13
Range("B40").Value = "Ｎ機械"
Range("Y40").Value = 115000
Range("AC40").Value = 14
Range("B41").Value = "Ｏ機械"
Range("Y41").Value = 116000
Range("AC41").Value = 15
Range("B42").Value = "Ｐ機械"
Range("Y42").Value = 117000
Range("AC42").Value = 16
Range("B43").Value = "Ｑ機械"
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 = "割引は、２０％になります。"
Range("D50").Value = "今後の取引状況で割引率は、上がります。"
Range("D51").Value = "余白１"
Range("D52").Value = "余白２"
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も含めるのかどうか分かりませんでした。
「備考：」は、有っても無くてもその位置にタイトルだけは書くのですか？ その通りです。データがあってもなくても表示するだけです。ですから保存の範囲には入れませんが、 保存先の見出しに"備考"をつけるつもりです。
気になりますのは、
１、AE27:AI48迄（金額）計算式が入っていますが、上記説明で計算式を外すとありましたが、保存の時には
合計の見出しと金額が入るのでしょうね。
２、見積内容の記載範囲（B27:X43）は、B列からX列まで２３列ですが、セルの範囲としては、B列のみです。
仮にB27行目のデータが最後の列X27迄記載されたとしましても保存先には全部のデータが２３列分使って
横並びに表示されるのでしょうか？
以上です。２回見直したのですが、よろしくお願いいたします。
（謙治） 2018/04/05(木) 14:51
（謙児） 2018/04/05(木) 15:15
＞AC5:AI5 , AC6:AI6 は、別々の項目です。
済みませーん。
実際にデータが入っているかどうかで、 保存範囲を把握する必要があることを失念しました。m(__)m
※セルを結合すると、実際のデータは左上の１セルにしかありません。←（これ重要）
なので、「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行目は、機械が利用しないところなので、後で手作業で何とでも調整できます。
＞気になりますのは、 ＞１、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 〒ＸＸＸ-ＸＸＸＸ 東京都新宿区 新宿第一ビル 〇〇〇〇〇 株式会社 御中 △△△△様 32357 2018/04/15 2018/05/18 納入月末締め、翌月末振込 Ａ機械 Ｂ機械 Ｃ機械 Ｄ機械 Ｅ機械 Ｆ機械 Ｇ機械 Ｈ機械 Ｉ機械 Ｊ機械 Ｋ機械 Ｌ機械 Ｍ機械 Ｎ機械 Ｏ機械 Ｐ機械 Ｑ機械 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 割引は、２０％になります。 今後の取引状況で割引率は、上がります。 余白１ 余白２
（半平太） 2018/04/05(木) 19:17
以下は、途中での返答です。
なので、「AC5:AC6」が正しい認識になります。 ac5とac6は、結合していませんが‐‐‐。
ところで、見積額 G18(32357）とAE48(14,867,712）が合致しないのは何故ですか？ G18は数式ではない事になっていますが、本当なんですか？ すみません、正しくは、Ｇ18のセルは、=ＡＥ48で答えは、14,867,712となります。
合致しないのは、こちらの手違いでした。（当初Ｇ１８のセルは、式で Ｇ１８=シート名：フォームコントロールの合計金額 結果、32357（数値）にしていました。
その後 私の勘違いで計算式は、入れないと言われたことを 例えばＧ１８=シート名：フォームコント
ロールの合計金額、これも計算式だと思い全て数値になおしていました。他の項目データも同じように
数値で表示しました。
その後で半平太さんのチェックの為にＡＥ列を全て入力したのですが、その時にＧ１８＝ＡＥ４８にするのを
忘れていました。）
改めてですが、シート名：見積書 の各項目のデータは、＝シート名：フォームコントロールの各項目
の式になおしても宜しいか？
＞「ご指定の場所」と言う決まり文句でしたか・・・、その様に理解します。
そのようにお願いします。
＞ これらは、実際にデータが入っているのは、「G21:G23」と言うことになります。
理解しました。
＞「見積内容の記載範囲（B27:X43）は、・・セルの範囲としては、B列のみです。 」とのお話がありました
ので 「B27:B43」「Y27:Y43」「AC27:AC43」に分割します。
理解しました。
＞ ＞保存先の見出しに"備考"をつけるつもりです。
＞ 保存シートの2行目は、機械が利用しないところなので、後で手作業で何とでも調整できます。
理解しました。
＞保存シートのデータをどう再利用したいと思っておられるのか、
＞ それを書いて頂ければ、何らかのアジャストは可能ではないかとは思っています。
＞ 一つの案が、上述のダイジェストシート作成です。
使用する人が、見積書の項目データを保存した後で、シート名：保存 で過去のデータを参照するときに
合計額は、ありますが、一行毎の単価×数量＝金額の金額がなければ、金額がないよと言われそうなので、
表示させて頂ければ有り難いと思います。
もし面倒なれば、使う人に計算式は、データ扱いで表示できません、確認をしたければ照会番号をキーに
してシート名：見積書 にデータを入れて見て下さい、と言います。
＞保存範囲の視認は下のプログラムで行ってください。対象範囲は選択されます。
＞保存されるデータは以下となります。（実際にデータが入っていない場合は、空白となります）
有難うございます。希望通りに範囲の選択は、行われています。
教えて頂きたいのですが、Ｂ２７からＢ４３迄のデータは、今はＢ列だけですが、見積り内容の範囲内で
例えば、Ｂ２７からＸ２７迄データがあるとしてもシート名：保存 に表示されますよね。
シート名：見積書 で、各項目データ
の式、=シート名：フォームコントロール(各項目データ）
（謙児） 2018/04/05(木) 22:53
（謙児） 2018/04/06(金) 03:26
＞なので、「AC5:AC6」が正しい認識になります。 ac5とac6は、結合していませんが‐‐‐。
結合とは無関係です。
別々にAC5、AC6 としても、合わせてAC5:AC6 としても殆んど同じです。 ※結合セルなら、左上のセルしか意味を為さないので、単にAC5と云う表現になります。
＞正しくは、Ｇ18のセルは、=ＡＥ48で答えは、14,867,712となります。 そうなると、G18は数式なので、保存対象から外れますよ。
＞使用する人が、見積書の項目データを保存した後で、シート名：保存 で過去のデータを参照するときに ＞合計額は、ありますが、一行毎の単価×数量＝金額の金額がなければ、金額がないよと言われそうなので、 ＞表示させて頂ければ有り難いと思います。
何度も書いていますが、保存シートのデータは人間が見て分かる様なレイアウトではありません。 そんな所を見に行かなくても、満足して貰えるような何らかの手当をするべきなんです。
第一、「金額明細がない」と分かったところで、その後、その利用者に何の足しがあるんでしょうか？ 「合計金額」ならまだ何か役に立つでしょうが、その金額明細なんて使いようがないと思うんですけども。
＞もし面倒なれば、使う人に計算式は、データ扱いで表示できません、確認をしたければ照会番号をキーに ＞してシート名：見積書 にデータを入れて見て下さい、と言います。
それで使う人に納得して貰えれば、確かに面倒がなくて助かります。
でも、私が使う人だったら、取引先名を入れるだけで、 その会社に関連する取引の照会番号(・日付・総額）とかの一覧が出て、 そこで目的の照会番号を選ぶと、見積書の形で取引が見える・・とか、
一旦、一つの取引が見れたら、その前の取引とか、次の取引がワンクリックで 次々に見える・・とかになって欲しいと思いますけどね。
いずれにしても、人間には見積書(又はそれと同じ様式）の形で見せるようにしなければならない。 そうじゃないと、結局、みづらい・使いづらい、との不満が噴出することになると思います。。
具体的なフローが私には分からないのですが、 ある取引を処理しようとすると、その取引の「照会番号」を知っている必要がありますよね？
目的の照会番号はどうやって認知・取得出来るんですか？
その認知に至るまでの過程がスムーズに運ばなければ全てがギクシャクします。 謙児さんは、そこのところには問題が起きない自信があるんですか？
＞教えて頂きたいのですが、Ｂ２７からＢ４３迄のデータは、今はＢ列だけですが、見積り内容の範囲内で ＞例えば、Ｂ２７からＸ２７迄データがあるとしてもシート名：保存 に表示されますよね。
表示されないです。「今はＢ列だけ」なんて仕様は無しです。
今後生じることなら、今は無くても、今から準備しておかなければならないです。
するとこの話も無しです。 ↓ ＞ 「見積内容の記載範囲（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
＞＞正しくは、Ｇ18のセルは、=ＡＥ48で答えは、14,867,712となります。
＞そうなると、G18は数式なので、保存対象から外れますよ。
では、
見積書の各データは、シート名：フォームコントロールの各項目に入力したデータを
見積書の同項目に＝シート名：フォームコントロールとしたいのですが、(現段階では、デスクトップのファイルは、あえて数値になおしていますが、）
＝を使うことが数式になるため、＝が使えないという事でしょうか？
そしたらシート名：見積書に直接入力をしないといけないということですね。
そうなると日付ボタンは、使えないのですか？（今は、シート名：フォームコントロールの日付ボタンは、
平成 年、月 日 その間にボタンで数字を選ぶようにして 別のセルN19に =DATE(H19,J19,L19) として
西暦になおしシート名：見積書の日付欄に＝シート名：フォームコントロールN19 としています。
＞何度も書いていますが、保存シートのデータは人間が見て分かる様なレイアウトではありません。
＞そんな所を見に行かなくても、満足して貰えるような何らかの手当をするべきなんです。
＞第一、「金額明細がない」と分かったところで、その後、その利用者に何の足しがあるんでしょうか？
＞合計金額」ならまだ何か役に立つでしょうが、その金額明細なんて使いようがないと思うんですけども
言われてみればその通りですね。わかりました。（金額明細の表示は、ないままでお願いします。）
＞でも、私が使う人だったら、取引先名を入れるだけで、
＞ その会社に関連する取引の照会番号(・日付・総額）とかの一覧が出て、
＞ そこで目的の照会番号を選ぶと、見積書の形で取引が見える・・とか、
＞一旦、一つの取引が見れたら、その前の取引とか、次の取引がワンクリックで
＞次々に見える・・とかになって欲しいと思いますけどでも、
先ほどの数式が入っている金額明細の話（すでに表示しないことを理解しています）以外は、
以前にも記載された、その前の取引とか、次の取引がワンクリックで次々に見える---
事を聞かされて、そういうことが出来るんだ、私は、そういうことが出来たらいいなあと思って
いましたので、実は、そこにたどり着くことを楽しみにしているのです。
という事で、私は、上記で言われるように、半平太さんの言われるようにしていきたいのですよ。
＞ いずれにしても、人間には見積書(又はそれと同じ様式）の形で見せるようにしなければならない。
見積書の形でみせるように---私もそれを望んでいましたから、当初金額明細の表示を入れてくださいと
言ったまでなんですよ。（現時点では、何回も言って申し訳ありませんが、その必要はありませんので）
＞ある取引を処理しようとすると、その取引の「照会番号」を知っている必要がありますよね？
＞目的の照会番号はどうやって認知・取得出来るんですか？
照会番号は、見積書を作る担当者に入力をして頂きます。その照会番号が、納品書、請求書の照会番号にも
同じ番号をつけます。
＞私としては、B〜Xは結合してしまい、一行まとめて入力したらどうかなぁと思うんですけど、
＞そうもいかないんですか？
いえいえ、いけますよ、嬉しいです。なぜならシート名：保存 のマクロコード実行する時点では、
B〜Xを結合していたのです。実行後、保存結果が適正な配置にいかないので、たくさんの列を結合することが
よくないのかと思い結合を外しました。
B〜X迄結合しますが、そちらの準備等もあるかとおもいますから結合してよい時には、言ってください。
それに合わせて見積書のセル幅を細かくしないで標準セルでやり直しましょうか？
（何か所かは、セル幅の狭い箇所も必要ですが、半平太さんに手を煩わしすぎてもいけませんから
これもやり直すのであれば改めて言ってください）
＞「B27:X43」にデータが入ってくるとして、本当に全部埋まることがあるんですか？
担当者に過去の見積書を見せてもらったのですが、見積内容は、多いところで１行２０文字位
行数は、１６行分です。
２７行から４３行目(各セル幅は１０以下です）までは、実際には、使わないと思います。
見積内容は、１行ごとに単価、数量、金額を記載するものとは限らず、１行目に入れる文字を
２行目にわたって関連文字をゆったりと入れている場合もあります。
見積内容の記載は、担当者が任意で記載、記入していただくところですから、万一文字列が多くなっても
シート名：保存に転記する時点で文字数が足らなくならないように、余分に設けただけです。
＞なんたって、C27からX43まで追加されたら、余分に374列必要になります。
＞尋常な数じゃないですよ？
CからX、27から43迄、縦横かけるので保存先の列は、３７４列分必要になるのですね。
知らなかったとは言え到底そんな列を作るなんてナンセンスですね。失礼しました。
結論は、金額明細の件を外して半平太さんのアイデアで進めて頂ければ喜ばしいことです。
お願いします。
＞ いずれにしても、人間には見積書(又はそれと同じ様式）の形で見せるようにしなければならない。
そうじゃないと、結局、みづらい・使いづらい、との不満が噴出することになると思います。。
（謙治） 2018/04/06(金) 11:34
は、前もってコピーしていたものが残っていました。不要です。（同じことを２回しました、今後注意します。すみません）
上記で記述するのを忘れていましたが、Ｂ列
Ｂ２７からＢ４３迄のデータをＢ列だけに記載しましたのは、
＞そちらの作業
＞ ３．長い文字列は簡単な表現に換える
と書かれてあったので文字数を１列分だけにしました。
以上です。
＞
（謙治） 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日の値が居座ってい＞るからです。
３月１日の値が居座るのは、シート名：保存 のところであって、元の見積書の日付セル、「＝フォームコントロールN19」またはその他の項目のセル「＝フォームコントロール 」のコピー元が何故壊れるのかが
わかりません。教えて頂けますか？
＞じゃ、どうすればいいかと言うと、3月14日の呼び出しの時、数式を壊さない為、日付欄には直接戻さず、
日付欄には直接戻さずとは、見積書の日付欄ですか？（G18）
＞フォームコントロールの「H19,J19,L19」に3月1日になる様なデータを入れることになります。
入れ終わったら見積書の各項目データにどうつなぐのですか？わたしが行ったように「＝フォームコントロール 」でつなげば数式がこわれますよね。
＞私としては、フォームコントロールシートをメニューシートの位置づけに出来ればいいのだが、と思ってい＞ます。
位置づけに出来ればとは、どういうふうにするのですか？ 現在、フォームコントロールシートを
メニューシートの位置づけにしている（式で＝フォームコントロールｘｘ）と思いますが。
と言いながら半平太さんが壊れると言っていますから別の意味を言ってそうな気はしますが。
＞もう一度、ありのままの状態で見積書の再現コードを作って頂くほかないと思いますけども。
＞それと最低限、フォームコントロールシートについても再現コードが必要になりますが、
頑張ってやってみます。
一度洗いなおしてフォームを変えます。（仕事の合間にしますから編集時間はかかりますが待って
いてください。必ずやります。）
１、セル幅を標準にします。（見積書の項目範囲でセル幅が少ないところも出ますが）
２、幅が広くなければいけないところは、結合します。
次から質問ですが、シート名：フォームコントロールシートで色々ボタンを利用して（例えば
支払先で、あらかじめ登録した名前を選択すると関連した支払先の〒番号、住所、見積内容が、
表示されます。）シート名：見積書に＝でつないでいますが、＝の式になっているため
フォームコントロールシート7は、やめた方がいいのでしょうか？
それとも、やめないとすれば、
＞私としては、フォームコントロールシートをメニューシートの位置づけに出来ればいいのだが、と思ってい＞ます
半平太さんが言われるように、フォームコントロールをメニューシートの位置づけに利用するので
あれば =以外、どのような方法があるのですか？
質問：フォームコントロールシートのデータを見積書に移すためには、＝(式）は、壊れるのであれば
見積書のシート上で色々なボタンを使ってやればいいのでしょうか？
それとも他にいい方法がありますか？
時間をかけても（私自身ですが）過去のデータを呼び出したり新規登録をしたりする半平太さんの
アイデアを行いたいので教えてください。
半平太さんも私が理解不足なために細かくわかりやすく説明をしていただいているのにも関わらず
半平太さんの意向に沿わず疲れていると思います。
私も半平太さんのマクロで範囲をとらえ、合っていましたので、次の段階へとつなげると楽しみに
していましたが、正直なところ疲れが一度にでまして力が抜けました。
でも負けません。長くなりましたが、なにとぞよろしくお願いいたします。
（謙治） 2018/04/06(金) 17:34
何か話が噛み合わないですね・・と言うより、却って空中分解気味ですね。
いままで「見積書シートのデータを保存する」と言う方向で進んでいたと思うんですが、
「フォームコントロールシートのデータを保存する」と言うのが正しい考え方なんでしょうか？
（半平太） 2018/04/06(金) 19:26
なら、根源データであるフォームコントロールのデータを保存して置けばいいハズです。
そのデータがあれば、見積書は数式によって正しく反映されるんでしょう？
過去のデータを呼び出す時は、保存シートからフォームコントロールシートの方へ埋め戻すことになります。
（半平太） 2018/04/06(金) 19:57
＞なら、根源データであるフォームコントロールのデータを保存して置けばいいハズです。
その方法がありますね、見積書を印刷するとともに保存することを考えていましたから
その考えが浮かばなかったです。
＞そのデータがあれば、見積書は数式によって正しく反映されるんでしょう？
その通りです。ありがとうございます。
＞過去のデータを呼び出す時は、保存シートからフォームコントロールシートの方へ埋め戻すことに
＞なります。
それは、理解できます。埋め戻したら見積書に＝によって反映しますから。
マクロのコードで見積書からフォームコントロールに替えますが
フォームコントロールシート名は長いので書きやすくするために
コントロールの"ＣＯＮ"にします。ゆえに シート名：ＣＯＮ です。
質問：
１、シート名：ＣＯＮ の見積り内訳は１行づつ結合してもよろしいか？
２、Ｂ列からＩ列迄の列の数は、そのままでいいのですか？
それともセルを標準に合わせて表を作りなおす方が、半平太さんがやり易いならそうします。
（謙児） 2018/04/06(金) 22:20
＞シート名：ＣＯＮ
１．「CON」は全角ですか、半角ですか？
＞１、シート名：ＣＯＮ の見積り内訳は１行づつ結合してもよろしいか？ ＞２、Ｂ列からＩ列迄の列の数は、そのままでいいのですか？ ＞ それともセルを標準に合わせて表を作りなおす方が、半平太さんがやり易いならそうします。
そちらのやり易い方で決めてください。 私としては、最終的なレイアウトを決めたら変更しないで欲しいと言うことだけです。
２．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 のフォームを整理して半平太さんに
送った場合には、以後項目箇所の変更は、ありません。
今、シート名：con をセル幅を標準にして不要なセルを削除しました。
見積内容の幅は、結合しました。
単価、数量の入力欄をシート名：フォームコントロール の時から１７行分にそれぞれ
コントロールボタンを作っていましたから、列を削除したことによってフォームコントロール
のボタン、コンボボックス(マクロでの位置の変更）及びスピンボタンの位置等の変更をしました。
狭い行間での貼付け、正しいセル位置の再確認等 目が疲れました。
その折、ふと思ったのですが、見積書では、＝の式を使っていたので保存するときに壊れると
なり 半平太さんにシート名：con を保存元に と言われ道があったと喜んでいたのですが、
うかつにもシート名：con の中にも計算式があったのです。
下記の計算は、con にあるデータです。 これは、計算しないと各合計が出ません。（con の範囲は、後日
お伝えするとして当初、見積書の右下Ｙ４５からＡＥ４９にあります）
ましてそのお見積合額金計ＡＥ４９の数字28、554を
お見積金額 \28,554（Ｇ１８のここに=ＡＥ４９としています。 ）
（消費税含みます。）
納 品 場 所
納 期
本見積有効期限
支 払 い 条 件
見積書の右下Ｙ４５からＡＥ４９にあります。が下記の表示です。
数量,金額合計 37,770
割引 30% -11,331
小 計 26,439
消費税 8% 2,115
お見積合額金計 28,554
色々知恵のない中で考えたのですが、con シートで計算式が入っている箇所をマクロの記録を
使って同シート内のその項目近くに貼り付けをし 貼付けした場所を保存の範囲にもってくる方法は、
駄目でしょうか？
（謙治） 2018/04/08(日) 22:16
＞うかつにもシート名：con の中にも計算式があったのです。
計算式が存在するのはあり得ることで、それ自体は問題ありません。
ただ、保存の対象には出来ない（一般論として）。 ・・と言うか、保存する必要自体が無いハズなんですよ（一般論として）。
何故って、その数式に使われている生データの方を保存して置けば、 数式が生きている限り、同じ値を算出してくれるからです。
これが、見積と納品の途中で消費税が変わったなんてことになると、 ちょっとややこしいことになります。 ※いまのところ、その話題に立ち入る予定はありませんが、 ややこしいことになるだろう事は、ご理解いただけると思います。
＞下記の計算は、con にあるデータです。 これは、計算しないと各合計が出ません。（con の範囲は、後日 ＞お伝えするとして当初、見積書の右下Ｙ４５からＡＥ４９にあります） ＞ ＞ましてそのお見積合額金計ＡＥ４９の数字28、554を ＞お見積金額 \28,554（Ｇ１８のここに=ＡＥ４９としています。 ） ＞（消費税含みます。） ＞納 品 場 所 ＞納 期 ＞本見積有効期限 ＞支 払 い 条 件 ＞見積書の右下Ｙ４５からＡＥ４９にあります。が下記の表示です。 ＞数量,金額合計 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
＞２．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 = "〒ＸＸＸ-ＸＸＸＸ"
Range("O7").Value = "担当"
Range("B8").Value = "東京都新宿区"
Range("O8").Value = "担当者 "
Range("P8").Value = "営業部長 △△△"
Range("B9").Value = "新宿第一ビル"
Range("O9").Value = "Ｅ‐ｍａｉｌ"
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 = "ＡＳＤＦ"
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、計算式が入っている色＝６、
単なる見出しの色＝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、計算式が入っている色＝６、 ＞単なる見出しの色＝35と半平太さんにわかっていた出来やすいように識別し直しました。 ＞内、Q27:R44の範囲は、ボタン（Q=単価ボタン、R=数量ボタン）をつけている範囲です。
この情報は助かりました。 無いと、この確認だけで、数回やりとりが必要になったところです。
１．まず、こちらサイドの構想ですが、保存シートは２種類作ります。
１つは、今までの方針にそった「保存」シートです。(呼出に使う）
あと１つは、「ダイジェスト」シートです。(取引先別の取引概要リスト作成に使う） 呼出し用のデータではないので、数式セルも保存対象にします。 それによって、いちいち呼出して計算結果を調べなくても合計金額などがダイレクトに把握できます。
ダイジェストなので、細かい情報は保存しません。 多分、取引先名、照会番号、日付、割引前、割引後、税込み後、進捗度(※) くらいでいいでしょう。
今は思いもよらないリストかも知れませんが、後でこれが必要だと思うようになります。
(※)進捗度とは、見積段階を1、納品段階を2、請求段階を3、入金確認を4とかにする(A,B,Cでもその他有意義なものなら何でも可） なので、conシートにもこの進捗度を書き込む場所を確保する必要があります。 この情報がないと、ダイジェストの有難味が半減します。 このデータは保存シートにも書き込んで、呼出でも使用します。
２．保存範囲 (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 Ｅ‐ｍａｉｌ 呼出(一つ過去) 入力不要 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
＞「ダイジェスト」シートです。
有り難い、アイデア、嬉しいです。
＞２．保存範囲
＞(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
実際にテストしてみると、セルをクリックする方式はダメですね。 矢印キーでも作動してしまい、実務には耐えられないです。
なので、右クリックイベントにします。
１．最初に、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枚追加 「サブリスト」、「ダイジェスト」と命名してください。
３．ダイジェストシートの1行目のタイトルを 以下のマクロ「onlyOnce」を使って書込み（上記１と同じ要領です）
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
４．現在の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 で消去してください。
５．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
’ここまで −−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
６．標準モジュール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
’ここまで＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
７．標準モジュール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
'１列内に存在する位置
Function RwNum(ByVal KEY, ByRef TargetWsh As Worksheet, ByVal 列 As Long) As Variant
RwNum = Application.Match(KEY, TargetWsh.UsedRange.Columns(列), 0)
End Function
'１列内に存在する数
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 = False
'保存範囲をクリアする
rngToClear.ClearContents
For Each cel In WshDEST.Range("A1", TopRightCell) '埋戻アドレス格納セルを取得
ValToBack = cel(Rw, 1).Value '保存したデータを取得
If Not IsEmpty(ValToBack) Then '保存データが入っていれば
WshSRC.Range(cel.Value) = ValToBack '該当アドレスに埋め戻す
End If
Next
Application.ScreenUpdating = True
End Select
End Function
Function isSufficiantData() As Boolean '入力必須データの確認
Dim cel
isSufficiantData = True
For Each cel In WshSRC.Range("S4,O5,P6,R6,T6,B7:B10,P8,O10,E19,F20,H20,J20,F21,H21,J21,E22").Areas
If Application.CountBlank(cel) > 0 Then
isSufficiantData = False
MsgBox "データが不足しています（例えば" & cel.Address(0, 0) & "セル）"
Exit For
End If
Next
If WshSRC.Range("D14") = 0 Then
MsgBox "請求額が0円です"
Exit Function
End If
End Function
Function getCustKEYbyPos(ByVal CustName, ByVal KEY, ByVal sPos As String)
Dim KEYS, Pos As Long
KEYS = getKEYsByCustName(CustName)
Select Case sPos
Case "Latest"
getCustKEYbyPos = KEYS(UBound(KEYS) - 1, 1) '最後尾はEmptyなので
Case "Backwards"
Pos = Application.Match(KEY, KEYS, 0)
getCustKEYbyPos = KEYS(Pos - 1, 1)
Case "Forwards"
Pos = Application.Match(KEY, KEYS, 0)
getCustKEYbyPos = KEYS(Pos + 1, 1)
End Select
End Function
Function getKEYsByCustName(ByVal CustName) '一つの取引先の照会番号一覧を作成して、最新照合番号をゲット
Dim dicT As Object
Dim Rw As Long, srcValKEY, srcValName
srcValKEY = WshDEST.UsedRange.Columns(保.照番).Value '照会番号列
srcValName = WshDEST.UsedRange.Columns(保.取引先番).Value '取引先名列
Set dicT = CreateObject("Scripting.Dictionary")
dicT(CustName) = Empty
For Rw = 3 To UBound(srcValName) '照会番号列（タイトル行を避ける）
If srcValName(Rw, 1) = CustName Then
dicT(srcValKEY(Rw, 1)) = Empty
ElseIf IsEmpty(srcValName(Rw, 1)) Then
Exit For
End If
Next Rw
Call 出力ソート(dicT, 3) 'dicTのキーを3列目に出力
dicT.RemoveAll
With WshSLT
getKEYsByCustName = .Range(.Cells(1, サブ.個別照番), _
.Cells(.Rows.Count, サブ.個別照番).End(xlUp).Offset(1)).Value
End With
End Function
Sub ListMaking() '当面使わない
Dim dicT As Object
Dim Ain, Aout
Dim srcVal
Dim i As Long, Rw As Long
Set dicT = CreateObject("Scripting.Dictionary")
Ain = Array(0, 保.照番, 保.取引先番) '0は配列位置調整の為のDummy
Aout = Array(0, サブ.照番, サブ.取引先番)
For i = 1 To 2
srcVal = WshDEST.UsedRange.Columns(Ain(i)).Value 'ターゲット列
For Rw = 2 To UBound(srcVal) '照会番号列(タイトル行も含める）
If IsEmpty(srcVal(Rw, 1)) Then
Exit For
Else
dicT(srcVal(Rw, 1)) = Empty
End If
Next Rw
Call 出力ソート(dicT, Aout(i))
dicT.RemoveAll
Next i
End Sub
Private Sub 出力ソート(ByRef dicT, ByVal COLout As Long)
Application.ScreenUpdating = False
With WshSLT
.Columns(COLout).ClearContents
.Cells(1, COLout).Resize(dicT.Count, 1).Value = Application.Transpose((dicT.KEYS))
With .Sort
.SortFields.Clear
.SortFields.Add KEY:=.Parent.Cells(2, COLout), SortOn:=xlSortOnValues, Order:=xlAscending
.SetRange .Parent.Cells(1, COLout).Resize(dicT.Count)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlStroke
.Apply
End With
End With
Application.ScreenUpdating = True
End Sub
'ここまで −−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
８．
下記「タイトルとアドレス書出」を使って、 保存シートの一行目(保存すべきセルのアドレス）を書き出してください。
Sub タイトルとアドレス書出() '一回実行すれば、消去してよし
Dim cel As Range
Dim COL As Long
Call 初期値設定
COL = 0
For Each cel In rngToStore
COL = COL + 1
WshDEST.Cells(1, COL).Value = cel.Address(0, 0)
Next
End Sub
’以上です
（半平太） 2018/04/11(水) 20:56
コードを走らせてイメージ通りにいったこと（コードで表された
表示を記載したり、提出したと会社から
合間を見つけて確認をして連絡します。と
書いてコメントプレビューをクリックしましたら
作動しませんと消えてしまいました。
いまから会社に行きます。
また会社から‐‐‐
（謙児） 2018/04/12(木) 12:00
やっとここに集中出来ます。色々あり遅くなって申し訳ございませんでした。
コードを実行した後の表示を下記に記載します。
●シート名：con での表示は、
メニュー（右クリック）
呼出 番号/名前 操作説明
新規 新規照会番号を入力してから、左セルを右クリック
呼出(照会番号で) 照会番号を入力してから、左セルを右クリック
呼出(取引先名で) 照会したい取引先名を入力してから、左セルを右クリックするとその顧客の最新取引が呼び出される
呼出(一つ過去) 入力不要 今表示されている取引先のもう一つ古い取引を見たい場合に左セルを右クリック
呼出(一つあと) 入力不要 今表示されている取引先のもうひとつ新しい取引を見たい場合に左セルを右クリック
呼出(直前保存分) 123456789 今さっき保存した取引を再度呼び出したい時、右クリック
保存 入力不要 今表示されている取引を保存したい時、右クリック
予備1
予備2
予備3
（個人的感想ですが、セルを右クリックするだけでコメントが出て処理ができるなんて凄いと思いました。
いまから４つくらい保存して 一つあと、一つ過去、等を実行していきます。
ただ、con シートでＹ２７からＹ３４ までが,
98
87 76 65 54 4 32 21 の表示が出ているのは、何なんでしょうか？ コードをよく見ればわかるのでしょが。
シート名：保存 の表示では、一行目はデータのセル位置---上手くいっています。（もちろんですが）
２行目は、項目名---上手く行っています。(同）
３行目は、データそのもの---上手くいっています。（同）
・シート名：ダイジェスト---上手くいっています（同）
・シート名：サブリスト----Ｃ列１行目には、支払先 Ｃ列２行目は照会番号 のみ 表示されています。
（これだけの表示で、いいのかどうかわかりませんが）
テスト的にいろいろ試しました。素晴らしいことが出来るんだなあと感激しています。
● 質問です。(私のやり方が間違っているかもしれませんが）
シート名：con で
１、メニュー（Ｖ列）の右、Ｗ列の番号/名前 が未記入の状態で、Ｖ列の 呼び出し（照会番号で）、
または、呼出し（取引先名で）のところで 各、右クリックをすると（照会番号）のところでは、
Ｗ７に照会番号・取引先名を入れてください とメッセージが出ます。
呼出し（取引先名で）のところでもＷ８に照会番号・取引先名をいれてください とメッセージが
出ます。
・メッセージの変更依頼としまして、照会番号のところでは、照会番号を入力してくださいのみ、
取引先名のところは取引先名のみ のメッセージでお願いしたいのですが。
２、呼出(一つ過去) の箇所：左セルを右クリックすると、メッセージで、これ以上過去の取引はあり
ませんと出ます。？ 本来、一つ過去のデータは、１件あります。
３、呼び出し(一つあと）の箇所：左セルを右クリックすると、メッセージで、これ以上新しい取引は
ありませんと出ます。？ 本来、一つ後のデータは、１件あります。
また、他に色々試して 再度上記３，４、共左セルを右クリックすれば時に、実行時エラー'１３'；
型が一致しません とエラーメッセージになる場合もあります。
４、呼び出し（直前保存分）---ここは、うまく行きます。
５、保存----ここもうまく行きます。
以下は、要望です。：
１、メニューの保存の右クリックを押せばすぐに保存されます。
この時に、ワンクッションおいて"保存してよろしいか"で ＹＥＳ ＯＲ ＮＯのメッセージを
ＹＥＳなら保存、ＮＯならもとに戻る、と出来ませんか？
（担当者があわて間違ってのクリックを防ぐ為）
２、呼び出し(取引先名で）の箇所で、照会したい取引先を入力してからとありますが、入力する名前の
文字数は、どの程度入力すればよろしいですか？
（一例として、名前をｘｘｘｘ御中と登録しています。その理由は、御中の表示をシート名：conの範囲
に含まず項目名みたいに記載しておきますと、登録している名前が長い場合に御中にかぶさると思い
登録にｘｘｘ御中としています。その折入力する名前は、御中迄入れるのでしょうか？）
●名前の欄、Ｂ７からＢ１１迄の保存範囲で１行空いていた場合、
メニューの保存を、左クリックをすると、データが不足しています（例えばＢ７：Ｂ１０セル）の
メッセージが出て前に進みません。
（１行空くという意味は、テストで実際の住所を登録したものを使いましたら、その名前の欄は、
社名欄と住所欄が１行だけで２行目は無いという意味です。）
参考：Ｂ７＝〒番号 Ｂ８＝住所１ Ｂ９＝住所２（ｘｘｘビル等）
Ｂ１０＝社名 Ｂ１１＝社名が長い場合の続きです。
・案としまして、例えば、データが不足しています。（例えばＢ７：Ｂ１０セル）ＹＥＳ ＯＲ ＮＯ
（ＹＥＳなら保存、ＮＯならもとに戻る）のメッセージを出す方法は如何でしょうか？
ほかにいいコメント等があると思いますが。
●最後に、E22の支払い条件のデータ、「納入月末締め、翌月末振込」は、保存範囲に入っていますが、
見積書の相手先が変わっても条件は変わりませんので、保存範囲から外して頂きたいのですが。
（当初外していたと思ったのですが、よく見ましたら外していませんでした。すみません。）
もし保存範囲の入れ替えでコード等のやり取りが、前回と同じ手間がかかるのでしたら、そのままにして
アイデアですが、シート名：見積書 の項目名、支払い条件のデータ箇所の式を＝con!e22 とせず
文字で「納入月末締め、翌月末振込」とします。 その場合には、シート名：保存 のＴ列１行目には、
Ｅ２２の表示が残りますが、無視しますので。）
その折、シート名：見積書 の支払い条件「納入月末締め、翌月末振込」を文字で表示させた場合には、
名前登録の"保存範囲"は、そのままにしてもよろしいでしょうか？それとも支払い条件のデータ範囲を
"保存範囲"から外さなければ行けませんか？
まとめが下手で申し訳ありませんが、よろしくお願いいたします。
（謙治） 2018/04/13(金) 18:39
＞ただ、con シートでＹ２７からＹ３４ までが, ＞ 98 ＞ 87 ＞ 76 ＞ 65 ＞ 54 ＞ 4 ＞ 32 ＞ 21 ＞ ＞の表示が出ているのは、何なんでしょうか？ コードをよく見ればわかるのでしょが。
１．こちらでは、再現しないです。 その範囲を一旦クリアして、何をやると再発するか観察をお願いします。
＞・シート名：サブリスト----Ｃ列１行目には、支払先 Ｃ列２行目は照会番号 のみ 表示されています。 ＞ （これだけの表示で、いいのかどうかわかりませんが）
２．現バージョンでは、C列だけでOKです。
※将来、照合番号の一覧 と 取引先名一覧 が必要になった場合、 それぞれ A列、B列に表示する予定にしてあるので、そうなっています。
シート名：con で ＞１、メニュー（Ｖ列）の右、Ｗ列の番号/名前 が未記入の状態で、Ｖ列の 呼び出し（照会番号で）、 ＞ または、呼出し（取引先名で）のところで 各、右クリックをすると（照会番号）のところでは、 ＞ Ｗ７に照会番号・取引先名を入れてください とメッセージが出ます。
＞ 呼出し（取引先名で）のところでもＷ８に照会番号・取引先名をいれてください とメッセージが ＞ 出ます。 ＞ ・メッセージの変更依頼としまして、照会番号のところでは、照会番号を入力してくださいのみ、 ＞ 取引先名のところは取引先名のみ のメッセージでお願いしたいのですが。
３．両方共おなじプログラムを使いますので、別々にメッセージを作るのが面倒だったので、 同じ文言にしました。
使う身になると、別々にして貰いたいですよね。＾＾ 修正対応します。
＞２、呼出(一つ過去) の箇所：左セルを右クリックすると、メッセージで、これ以上過去の取引はあり ＞ ませんと出ます。？ 本来、一つ過去のデータは、１件あります。 ＞３、呼び出し(一つあと）の箇所：左セルを右クリックすると、メッセージで、これ以上新しい取引は ＞ ありませんと出ます。？ 本来、一つ後のデータは、１件あります。 ＞ また、他に色々試して 再度上記３，４、共左セルを右クリックすれば時に、実行時エラー'１３'； ＞ 型が一致しません とエラーメッセージになる場合もあります。
４．こちらでは再現しないですねぇ。。 (1)取引先名が厳密に同じと言えない状況になっている、と言うことは無いですか？ 一つスペースが多くても、別の取引先と判定されますが。
(2)直接、保存シートのデータを変更した、と言うことはありませんか？
(3)エラーが出た時、デバッグモードに入ると思うのですが、 どこのプログラム行が黄色くなって止まっているか、メモしてここにアップしてください。
＞以下は、要望です。： ＞１、メニューの保存の右クリックを押せばすぐに保存されます。 ＞ この時に、ワンクッションおいて"保存してよろしいか"で ＹＥＳ ＯＲ ＮＯのメッセージを ＞ ＹＥＳなら保存、ＮＯならもとに戻る、と出来ませんか？ ＞ （担当者があわて間違ってのクリックを防ぐ為）
５. 修正対応します。
＞２、呼び出し(取引先名で）の箇所で、照会したい取引先を入力してからとありますが、入力する名前の ＞ 文字数は、どの程度入力すればよろしいですか？ ＞ ＞ （一例として、名前をｘｘｘｘ御中と登録しています。その理由は、御中の表示をシート名：conの範囲 ＞ に含まず項目名みたいに記載しておきますと、登録している名前が長い場合に御中にかぶさると思い ＞ 登録にｘｘｘ御中としています。その折入力する名前は、御中迄入れるのでしょうか？）
６．これについては、少し変わったデータの持ち方をするなぁとは思っていました。 通常、マスタへの登録は、御中は入れないものですからねぇ。。
ただ、顧客に個人もいた場合、御中と様を使い分けなければならない。 ・・なら、いっそのこと、御中・様を付けて取引先名とした方が いいのかも知れない・・と納得していたんですけども。
その理解で作っていますので、御中・様まで入れて頂かないと取引先名として成立しません。
※小手先の対応は出来なくもないですが、そう言うひび割れが、徐々にシステムの寿命を縮めます。
私としては気が進まないので、必要であればそちらで対応をお願いします。
＞ ●名前の欄、Ｂ７からＢ１１迄の保存範囲で１行空いていた場合、 ＞ メニューの保存を、左クリックをすると、データが不足しています（例えばＢ７：Ｂ１０セル）の ＞ メッセージが出て前に進みません。 ＞ （１行空くという意味は、テストで実際の住所を登録したものを使いましたら、その名前の欄は、 ＞ 社名欄と住所欄が１行だけで２行目は無いという意味です。） ＞ ＞ 参考：Ｂ７＝〒番号 Ｂ８＝住所１ Ｂ９＝住所２（ｘｘｘビル等） ＞ Ｂ１０＝社名 Ｂ１１＝社名が長い場合の続きです。 ＞ ・案としまして、例えば、データが不足しています。（例えばＢ７：Ｂ１０セル）ＹＥＳ ＯＲ ＮＯ ＞ （ＹＥＳなら保存、ＮＯならもとに戻る）のメッセージを出す方法は如何でしょうか？ ＞ ほかにいいコメント等があると思いますが。
７．私としては、必須のデータだけに絞りたいので、未入力もあり得るセルはチェック対象外にすることで済ませたいです。 具体的には、B7,B8,B10 のみチェックする、となります。 ＞ ●最後に、E22の支払い条件のデータ、「納入月末締め、翌月末振込」は、保存範囲に入っていますが、 ＞ 見積書の相手先が変わっても条件は変わりませんので、保存範囲から外して頂きたいのですが。 ＞ （当初外していたと思ったのですが、よく見ましたら外していませんでした。すみません。） ＞ ＞ もし保存範囲の入れ替えでコード等のやり取りが、前回と同じ手間がかかるのでしたら、そのままにして ＞ アイデアですが、シート名：見積書 の項目名、支払い条件のデータ箇所の式を＝con!e22 とせず ＞ 文字で「納入月末締め、翌月末振込」とします。 その場合には、シート名：保存 のＴ列１行目には、 ＞ Ｅ２２の表示が残りますが、無視しますので。） ＞ その折、シート名：見積書 の支払い条件「納入月末締め、翌月末振込」を文字で表示させた場合には、 ＞ 名前登録の"保存範囲"は、そのままにしてもよろしいでしょうか？それとも支払い条件のデータ範囲を ＞ "保存範囲"から外さなければ行けませんか？
８．本番データがない段階なので、 対応できるとは思いますが、トラブりの原因にならなければいいがなぁと少し不安モードです。
ーーーーーーーーーー 処置まとめ ーーーーーーーーーーーーーーー １．再現待ち
２．問題なし
３．「事前チェック」モジュール内の下記プログラムを以下に丸ごと差し替え
Function callable呼出指定(ByRef Target As Range, ByVal strAdrToFil) As Boolean
Dim KEY
Dim DefMsg
If isPreNewOK = False Then Exit Function
KEY = Target.Offset(, 1).Value
If IsEmpty(KEY) Then
If Target.Row = 7 Then
DefMsg = "セルに「照会番号」を入れてください"
ElseIf Target.Row = 8 Then
DefMsg = "セルに「取引先名」を入れてください"
Else
DefMsg = "セルにあるべき照会番号がありません。"
End If
MsgBox strAdrToFil & DefMsg
Exit Function
End If
callable呼出指定 = True
End Function
４．調査・再現報告待ち
５．conシートモジュール内にある「BeforeRightClick」の最後尾にある
＞ Case "V12" ' 保存 → ＞ If isSufficiantData = False Then ＞ Exit Sub
ーーの部分だけ、以下に差し替えーー
Case "V12" ' 保存 →
If MsgBox("保存してよろしいですか？", vbOKCancel) = vbCancel Then
Exit Sub
ElseIf isSufficiantData = False Then
Exit Sub
６．見解表明待ち
７．下記８に抱合
８ー(1) 保存シートのT列(トップに"E22"と書かれている列）を「列削除」してください。
８−(2) 以下のマクロを実行して、保存範囲の変更を行う
Sub 保存範囲変更()
With Worksheets("con")
ThisWorkbook.Names("保存範囲").Delete
.Range("O5,P6,R6,T6,B7:B11,P8,O10,O13,E19,F20,H20,J20,F21,H21,J21,B27:B44,N27:N44,O27:O44,B46:B49,S4").Name = "保存範囲"
End With
End Sub
８−(3)「共通」モジュール内にある「初期値設定」プログラムを部分差し替える
＞ 'クリアする時は、結合セルの情報が必要 ＞ 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"
ーーの部分だけ、以下に差し替えーー
'クリアする時は、結合セルの情報が必要
clearScope = "O5:P5,P6,R6,T6,B7:B11,P8,O10,O13,E19,F20,H20,J20," & _
"F21,H21,J21,B27:M44,N27:N44,O27:O44,B46:L49,S4"
８−(4)「共通」モジュール内にある「isSufficiantData」プログラムを以下に丸ごと差し替え
Function isSufficiantData() As Boolean '入力必須データの確認
Dim cel
isSufficiantData = True
For Each cel In WshSRC.Range("S4,O5,P6,R6,T6,B7,B8,B10,P8,O10,E19,F20,H20,J20,F21,H21,J21,S4").Areas
If Application.CountBlank(cel) > 0 Then
isSufficiantData = False
MsgBox "データが不足しています（例えば" & cel.Address(0, 0) & "セル）"
Exit Function
End If
Next
If WshSRC.Range("D14") = 0 Then
isSufficiantData = False
MsgBox "請求額が0円です。処理を中止します。"
Exit Function
End If
End Function
（半平太） 2018/04/14(土) 00:11
＞１．こちらでは、再現しないです。
その範囲を一旦クリアして、何をやると再発するか観察をお願いします。 そのようにします。
＞２．現バージョンでは、C列だけでOKです。
※将来、照合番号の一覧 と 取引先名一覧 が必要になった場合、 それぞれ A列、B列に表示する予定にしてあるので、そうなっています。 承知しました。 将来まで考えて頂き有難うございます。
＞３．両方共おなじプログラムを使いますので、別々にメッセージを作るのが面倒だったので、
同じ文言にしました。 使う身になると、別々にして貰いたいですよね。＾＾ 修正対応します。 有難うございます。（私もひょっとしたら同じようなないようなので同じ文言にされたのでは、と思いまし た。）
＞４．こちらでは再現しないですねぇ。。
＞(1)取引先名が厳密に同じと言えない状況になっている、と言うことは無いですか？ 一つスペースが多くても、別の取引先と判定されますが。 保存の取引先名をコピペしていますので‐‐‐ ＞(2)直接、保存シートのデータを変更した、と言うことはありませんか？ それは、ありません、
＞(3)エラーが出た時、デバッグモードに入ると思うのですが、 どこのプログラム行が黄色くなって止まっているか、メモしてここにアップしてください。 すみません、デバッグのボタンでたしかめ控えていましたのに、アップするのを忘れていました。 下記コードの Pos = Application.Match(KEY, KEYS, 0)の部分が黄色くなりました。
Function getCustKEYbyPos(ByVal CustName, ByVal KEY, ByVal sPos As String)
Dim KEYS, Pos As Long
KEYS = getKEYsByCustName(CustName)
Select Case sPos
Case "Latest"
getCustKEYbyPos = KEYS(UBound(KEYS) - 1, 1) '最後尾はEmptyなので
Case "Backwards"
Pos = Application.Match(KEY, KEYS, 0)
getCustKEYbyPos = KEYS(Pos - 1, 1)
Case "Forwards"
Pos = Application.Match(KEY, KEYS, 0)
getCustKEYbyPos = KEYS(Pos + 1, 1)
End Select
End Function
＞＞以下は、要望です。：
＞１、メニューの保存の右クリックを押せばすぐに保存されます。 ＞ この時に、ワンクッションおいて"保存してよろしいか"で ＹＥＳ ＯＲ ＮＯのメッセージを ＞ ＹＥＳなら保存、ＮＯならもとに戻る、と出来ませんか？ ＞ （担当者があわて間違ってのクリックを防ぐ為）
＞ ５. 修正対応します。
有難うございます。
＞ ６．これについては、少し変わったデータの持ち方をするなぁとは思っていました。
通常、マスタへの登録は、御中は入れないものですからねぇ。。
ただ、顧客に個人もいた場合、御中と様を使い分けなければならない。
・・なら、いっそのこと、御中・様を付けて取引先名とした方が
いいのかも知れない・・と納得していたんですけども。
その理解で作っていますので、御中・様まで入れて頂かないと取引先名として成立しません。
※小手先の対応は出来なくもないですが、そう言うひび割れが、徐々にシステムの寿命を縮めます。
＞ 私としては気が進まないので、必要であればそちらで対応をお願いします。
全て理解しました。
＞＊そう言うひび割れが、徐々にシステムの寿命を縮めます。
そういうものなんですね、頭に入れておきます。こちらで対応します。
＞７．私としては、必須のデータだけに絞りたいので、未入力もあり得るセルはチェック対象外にすること
で済ませたいです。
それで結構です。
＞具体的には、B7,B8,B10 のみチェックする、となります。
有難うございます。 たすかります。
＞ その折、シート名：見積書 の支払い条件「納入月末締め、翌月末振込」を文字で表示させた場合に
は、 名前登録の"保存範囲"は、そのままにしてもよろしいでしょうか？それとも支払い条件のデータ
範囲を ＞ "保存範囲"から外さなければ行けませんか？
＞ ８．本番データがない段階なので、
＞対応できるとは思いますが、トラブりの原因にならなければいいがなぁと少し不安モードです。
トラブルの原因にならないためにも、名前登録の"保存範囲"は、そのままにします。
上記の
＞ ＞７．私としては、必須のデータだけに絞りたいので、未入力もあり得るセルはチェック対象外に
＞することで済ませたいです。
と同じように「納入月末締め、翌月末振込」のところもチェック対象外にして頂ければ問題も
起こらないのでは、ないでしょうか？
私のこの質問の後、次の半平太さんの修正コメント（下記保存範囲の変更）をみて実行しましたら
「納入月末締め、翌月末振込」が範囲から外されていました。有難うございます。
トラブりの原因にならないですよね。もしトラブルが後々にでる可能性があれば、今私が出来る
範囲で変更協力しますが。（期間がたって何かトラブルが起こってもその時点で相談するのも
調べるのに大変困難だし申し訳ありませんから）
ただ下記の範囲を実行した後で保存範囲をクリックしましたら、先ほどの「納入月末締め、翌月末振込」が
範囲から外されていましたが、支払先名の箇所はＢ９（支払先の住所２行目）とＢ１１（名前の２行目）が
範囲の中に含まれたままでした、？
＞８−(2) 以下のマクロを実行して、保存範囲の変更を行う
Sub 保存範囲変更()
With Worksheets("con")
ThisWorkbook.Names("保存範囲").Delete
.Range("O5,P6,R6,T6,B7:B11,P8,O10,O13,E19,F20,H20,J20,F21,H21,J21,B27:B44,N27:N44,O27:O44,B46:B49,S4").Name = "保存範囲"
End With
＞End Sub
以上です。
上記変更するコードは、全て入れました。
一旦先に私がここに記載しましたコメントを提出します。（少しでも早く半平太さんにお渡ししたいと
思いまして‐‐）
その後、改めてコードの変更後 質問、提案したことをテストしていきます。
色々有難うございます。
（謙児） 2018/04/14(土) 06:30
＞ また、他に色々試して 再度上記３，４、共左セルを右クリックすれば時に、実行時エラー'１３'； ＞ 型が一致しません とエラーメッセージになる場合もあります
B10セルに取引先名が入っていて、O5セルには照合番号が入っていない と言う状況でそのコマンドを実行すると、再現しました。
ただ、何故そんな事態が起きるのは不明です。 「新規取引」なら、照合番号は真っ先に埋まるデータですよね？ 「呼出」なら、照合番号がないと言う事態は起こり得ないですし・・
いずれにしても、データ間相互チェックを強化した方がいいので、以下の処置を行います。
１.「事前チェック」モジュール内の下記プログラムを以下に丸ごと差し替え
Function callable呼出自動(ByRef Target As Range, ByVal rngrToCheck As Range) As Boolean
Dim KEY, PosOfRefNo
If isPreNewOK = False Then Exit Function
KEY = rngrToCheck.Value
If IsEmpty(KEY) Then
MsgBox rngrToCheck.Address(0, 0) & "セルにデータがありません"
Exit Function
ElseIf IsEmpty(refNoCell) Then
MsgBox refNoCell.Address(0, 0) & "セルにデータがありません"
Exit Function
Else '取引先名、照合番号ｎ存在確認
If Application.CountIf(WshDEST.Columns("H"), KEY) = 0 Then
MsgBox KEY & "と云う取引先はまだ存在しません"
Exit Function
ElseIf Application.CountIf(WshDEST.Columns("A"), refNoCell) = 0 Then
MsgBox refNoCell.Value & "と云う照合番号はまだ存在しません"
Exit Function
Else
PosOfRefNo = Application.Match(refNoCell.Value, WshDEST.Columns("A"), 0)
If WshDEST.Cells(PosOfRefNo, "H").Value <> KEY Then
MsgBox "その取引先には、その照合番号の取引が存在しません"
Exit Function
End If
End If
End If
callable呼出自動 = True
End Function
＞ トラブりの原因にならないですよね。もしトラブルが後々にでる可能性があれば、今私が出来る ＞ 範囲で変更協力しますが。（期間がたって何かトラブルが起こってもその時点で相談するのも ＞ 調べるのに大変困難だし申し訳ありませんから）
ははは、一箇月も経てば、すっかり忘れます。 Q&Aの回答なんて、そんなもんです。
こちらは暇つぶしとしてやっているので、 どんな対応になるかは、その時点での気分次第です。悪しからず。
現在は、本番前の段階なので、「保存範囲を変更する」と決断して走り出しています。 また、元に戻すのもリスクです。
新方針に従って、トラブルを出し切る方向でテストをお願いします。
＞ ただ下記の範囲を実行した後で保存範囲をクリックしましたら、先ほどの「納入月末締め、翌月末振込」が ＞ 範囲から外されていましたが、支払先名の箇所はＢ９（支払先の住所２行目）とＢ１１（名前の２行目）が ＞ 範囲の中に含まれたままでした、？
２．えーと、入力必須データとしてはチェックしないだけで、 そこにデータが書いてあるか無いかにかかわらず、保存対象にはなります。
（半平太） 2018/04/14(土) 11:50
新方針に従って、トラブルを出し切る方向でテストをお願いします。 はい、色々テストしながらそのようにしていきます。
●＞８−(2) 以下のマクロを実行して、保存範囲の変更を行う
Sub 保存範囲変更()
With Worksheets("con")
ThisWorkbook.Names("保存範囲").Delete
.Range("O5,P6,R6,T6,B7:B11,P8,O10,O13,E19,F20,H20,J20,F21,H21,J21,B27:B44,N27:N44,O27:O44,B46:B49,S4").N
ame = "保存範囲"
End With
＞End Sub
このコードは、前回と同じく削除してもよろしいですね。
●シート名：Ｗｓｈ （conのデータ範囲）は、残ったままでしたので、削除してもよろしいですね。
●シート名：保存 の３行目からのデータを消去してもよろしいですね。(最初からやり直すつもりです）
シート名：ダイジェストの２行目からのデータも消去してもよろしいですね。( 〃 ）
＞２．えーと、入力必須データとしてはチェックしないだけで、
＞そこにデータが書いてあるか無いかにかかわらず、保存対象にはなります。
有難うございます。理解しました。
＞１.「事前チェック」モジュール内の下記プログラムを以下に丸ごと差し替え
実行しました。
言い訳したくないのですが、当社、決算ですのであわただしく過ごしています。
一生懸命にしていただいていますので、いち早く対応したいのですが、合間、合間になって申し訳ありません
が、お待ちください。
（謙治） 2018/04/14(土) 14:20
＞いち早く対応したいのですが、合間、合間になって申し訳ありません
Q＆Aなので、お互いマイペースで行きたいです。
まぁ、そちらはどっちにしても仕事でしょうが、本業優先でやってください。
こっちは、あくまで暇つぶしです。 他に面白い質問があれば、そっちで暇をつぶすだけです。
＞Sub 保存範囲変更() ＞このコードは、前回と同じく削除してもよろしいですね。
一回こっきりのものです。削除してください。
＞●シート名：Ｗｓｈ （conのデータ範囲）は、残ったままでしたので、削除してもよろしいですね。
削除してください。
＞●シート名：保存 の３行目からのデータを消去してもよろしいですね。(最初からやり直すつもりです） ＞ シート名：ダイジェストの２行目からのデータも消去してもよろしいですね。
はい、その方が好ましいです。 整合性のない情報を読み込んでしまってトラブる、なんてことが防げますので。
＞追伸：呼び出しの取引先名を入れた場合に、 ＞シート名 保存に 同じ取引先名がある場合に、 ＞どれが、呼び出しされるのでしょうか？
当該取引先の最新版です。
ただ、「最新版」をどう判定するかですが、現在は、照合番号の大きい方としています。 エクセルで昇順に並べ替えたとき、一番下に来る照合番号のものです。
＞(実際に見積書を発行の場合に同じ取引先名で複数件 ＞発行されますので、自分が同じ取引先名の内、 欲しいデータを導く場合です。）
「欲しいデータ」とは何かと言うことが明確じゃないと語りにくいです。
本来、照合番号が分かっていれば、照合番号を入れて呼び出すんですが、 それが直ぐ分からない場合、目的とする取引先名が持っている照合番号のどれかと言うことになります。
上述の通り、「呼出(取引先名で）」で最新版が出ますので、 そのあと「呼出(ひとつ過去）」を右クリックして、「欲しい」取引データが出るまで、 右クリックを続ける、と言うのが実際的だと思います。
（半平太） 2018/04/14(土) 15:14
あと、直前に保存した取引が目的の取引先であることが分かっているなら、
「呼出(直前保存分)」を右クリックした方が簡単に辿り着けます。
（半平太） 2018/04/14(土) 15:24
＞「欲しいデータ」とは何かと言うことが明確じゃないと語りにくいです。
「欲しいデータ」とは、同じ取引先名でシート名：保存 に４件ほど同一名があった場合に、
ＡＳＤの内訳明細を見積書に呼出しをしたいという場合です。
でも今、答えを書いている間にふと気づいたのですが、取引先名で選ぶから選択がしにくい、
照会番号で呼び出したら呼び出しが早いので担当者には、そのように伝えます。
＞上述の通り、「呼出(取引先名で）」で最新版が出ますので、
＞ そのあと「呼出(ひとつ過去）」を右クリックして、「欲しい」取引データが出るまで、
＞ 右クリックを続ける、と言うのが実際的だと思います。
思いつかなかったですが、その方法が、便利で、最善ですね。
途中経過です。
（謙治） 2018/04/14(土) 16:22
半平太さんが、コメントされました,
＞新方針に従って、トラブルを出し切る方向でテストをお願いします。
を見まして
私なりに一生懸命、チェックしたつもりです。
con のデータ範囲と同範囲を保存した時のデータセル番地のチェックをしました。
見積内訳（正しい範囲、Ｂ２７からＢ４７）と単価(正しい範囲、Ｎ２７からＮ４４）、数量（〃範囲、Ｏ２７からＯ４４）と備考欄（〃範囲、Ｂ４６からＢ４９）、進捗度（Ｓ４）以外は、正しく表示されていま
す。
見積内訳につきましては、
（正しい範囲、Ｂ２７からＢ４７(Ｂ列からＭ列迄を結合しています。）、半平太さんから、以前結合したら
左端がセルの範囲となるとお聞きしているのを承知の上でお伝えしますが、
(シート名：保存 の１行目に シート名：con のＢ列からＭ列のセル番地が来ています、（そこの３行目には、データも入っています））
シート名：保存 に転記されたとき、１行目のデータセルは、Ｔ列の１行目には、Ｂ２７が正しくきて
います。 しかしＵ列からＡＥ列（データのセルは、Ｃ２７から続けてＭ２７迄）とＡＦ列からＡＫ列
（〃は、Ｂ２８から続けてＧ２８迄）は、誤りです。只、実際のデータは、Ｕ列からＡＫ列迄 シート名：
con の見積内訳のＢ２７からＢ４４のデータがもれなく続けて入っています。
次に単価は、ＡＬ列からＡＱ列で、１行目は、Ｈ２８からＭ２８、とＡＲ列からＢＣ列で１行目は、
Ｂ２９からＭ２９迄、数量は、ＢＤ列からＢＯ列で１行目は、Ｂ３０からＭ３０、ＢＰ列からＢＵ列で
１行目は、Ｂ３１からＧ３１迄備考欄は、ＢＶ列からＢＹ列でＨ３１からＫ３１迄進捗度は、ＢＺ列で
Ｌ３１ です。
以前、上記の各データは、シート名：保存 に正しく転記されていましたが---。
（１行目のセルもconシートのセルと共に確認をしました。）
メニューにつきましての質問です。
新規 ＝本来、どいう意味を持つのですか？
（私のやり方が悪いかもしれませんが、新規番号を入力して右クリックしましたら照会番号だけ残り他の
データは消えます。）
呼出（照会番号と取引先名）＝うまく行きました。
呼出（一つ過去）＝コメント、Ｂ１０セルにデータはありません と出ます。？
（保存から呼ぶのですから Ｂ１０のデータは、入っています。）
何故、呼ぶことが出来なのでしょうか？
呼出（一つあと）＝コメント、これ以上新しい取引は、ありません と出ます。
（もちろん保存シートでもう一つ新しい取引があるのを確認しています。）
呼出（直前保存分）と保存＝今のところ上手く行っています。
きっと私のやり方が間違ってるのでしょう。
色々素晴らしいアイデアを出されていますので、今後について楽しみにしているのです。
どうぞよろしくお願いいたします。
（謙治） 2018/04/15(日) 21:24
＞見積内訳（正しい範囲、Ｂ２７からＢ４７）と単価(正しい範囲、Ｎ２７からＮ４４）、 ＞数量（〃範囲、Ｏ２７からＯ４４）と備考欄（〃範囲、Ｂ４６からＢ４９）、 進捗度（Ｓ４）以外は、正しく表示されています。
「以外」ですか！？ それじゃ根本的におかしいです。旨く行くハズがないです。
保存シートの1行目に「M」はもう在りえないアドレスです。
最新版の保存範囲が正しく反映されていないです。 以下のプログラムで、アドレスを修正してください。
’標準モジュールに貼り付けて実行、一回こっきり。
Sub 保存シートの1行目のアドレス修正()
Dim cel As Range
Dim CL As Long
初期値設定
WshDEST.Row(1).ClearContents
CL = 0
For Each cel In rngToStore
CL = CL + 1
WshDEST.Cells(1, CL).Value = cel.Address(0, 0)
Next cel
End Sub
＞次に単価は、ＡＬ列からＡＱ列で、１行目は、Ｈ２８からＭ２８、とＡＲ列からＢＣ列で１行目は、 ＞Ｂ２９からＭ２９迄、数量は、ＢＤ列からＢＯ列で１行目は、Ｂ３０からＭ３０、ＢＰ列からＢＵ列で ＞１行目は、Ｂ３１からＧ３１迄備考欄は、ＢＶ列からＢＹ列でＨ３１からＫ３１迄進捗度は、ＢＺ列でＬ３１ です。
実際に保存されたデータの順序は正しいので、上のプログラムを実行すれば、呼出も正常化します。 それまでは、呼出を行うととんでもない所にデータが表示されます。
＞メニューにつきましての質問です。 ＞新規 ＝本来、どいう意味を持つのですか？ ＞（私のやり方が悪いかもしれませんが、新規番号を入力して右クリックしましたら照会番号だけ残り他の ＞データは消えます。）
そちらの新規取引の入力方法は確認しなかったですが、 「新規」なので新規照会番号をW6セルに入力後、V6セルを右クリックして、操作スタートとなると想定しています。
なので、照会番号以外は、新しい情報を入れるエリアなので全てクリアーしています。 下手に以前のデータを残すと、ミスの元になりますので。
もしかして、全部データを入れてから、最後の方で新規の照会番号を入力するんでしょうか？
＞呼出（一つ過去）＝コメント、Ｂ１０セルにデータはありません と出ます。？ ＞（保存から呼ぶのですから Ｂ１０のデータは、入っています。） ＞何故、呼ぶことが出来なのでしょうか？
本当に「Ｂ１０セル」に取引先名が入っているのに、「Ｂ１０セルにデータはありません」と出るんでしょうか？ 信じられないので、再確認をお願いします。
＞呼出（一つあと）＝コメント、これ以上新しい取引は、ありません と出ます。 ＞（もちろん保存シートでもう一つ新しい取引があるのを確認しています。）
以前にも、同じお話がありましたが、ちょっと信じられないです。
上記「保存シートの1行目のアドレス修正」を実行した後でも、 同じ事が起きるなら、本格的に検討を開始します。
（半平太） 2018/04/15(日) 23:46
最後に、保存シートの1行目の右端が、BZ列で終わっており、CA列以降には何もないことを確認してください。
（半平太） 2018/04/16(月) 00:02
上のコメントは忘れてください。
なんか、そちらのデータの在り様が十分に分からなくて、行き違いがあり過ぎの感が強いです。 あとでテスト用のデータをアップしますので、それをテストのベースとしてください。
テストデータは後でアップするプログラムで作ることにします。
※タイトルと取引２件分のみです。
※大部分のデータは、引っ張ってくるべき「セル番地」に変えたデータです。（取引データらしくないものです） それで対応関係が合致するのが分かると思います。
※既存のテストデータは全てクリアされます。
※保存シート用とダイジェストシート用を作ります。 それぞれのシートでデータ再構築を実施していただくことになります。
上記のプログラムを準備するのにちょっと時間が掛かります。 それまで、しばらくお待ちください。m(__)m
（半平太） 2018/04/16(月) 08:07
保存シートとダイジェストシートの再構築プログラムを作成しましたので、 「標準モジュール」に貼り付けて実行してください。
※ ２つのシートを一括して再構築します。一回こっ切り。
’ここから
Sub 保存用およびダイジェスト用データ一括作成()
Dim cel As Range
Dim CL As Long
'保存範囲変更()
With Worksheets("con")
ThisWorkbook.Names("保存範囲").Delete
.Range("O5,P6,R6,T6,B7:B11,P8,O10,O13,E19,F20,H20,J20,F21,H21,J21,B27:B44,N27:N44,O27:O44,B46:B49,S4").Name = "保存範囲"
End With
初期値設定
WshDEST.Cells.ClearContents
'１と３，４行目にアドレス書き出し
CL = 0
For Each cel In rngToStore
CL = CL + 1
WshDEST.Cells(1, CL).Value = cel.Address(0, 0)
WshDEST.Cells(3, CL).Value = cel.Address(0, 0)
WshDEST.Cells(4, CL).Value = cel.Address(0, 0)
Next cel
'2行目タイトル書き出し
WshDEST.Range("A2,H2").Value = Array("照合番号", "取引先名")
'3、4行目にアドレス以外を上書き
With Sheets("保存")
Rem 生データのセルをまとめて処理
.Range("A3,D4,S4").Value = 1
.Range("B3:B4,N3:N4,Q3:Q4").Value = 30
.Range("C3:C4,O4").Value = 4
.Range("D3").Value = 8
.Range("E3:E4").Value = "〒ＸＸＸ-ＸＸＸＸ"
.Range("F3:F4").Value = "東京都新宿区"
.Range("G3:G4").Value = "新宿第一ビル"
.Range("H3:H4").Value = "〇〇〇株式会社 御中"
.Range("I3:I4").Value = "△△△様"
.Range("J3:J4").Value = "営業部長 △△△"
.Range("K3:K4").Value = "xxxxxxxxxx"
.Range("L3:L4").Value = "フロント"
.Range("M3:M4").Value = "ご指定の場所"
.Range("O3,R3:R4").Value = 5
.Range("P3:P4,A4").Value = 2
.Range("S3").Value = 31
.Range("AL3:BU4").FormulaR1C1Local = "=RIGHT(R1C,2)*1"
.Range("AL3:BU4").Value = .Range("AL3:BU4").Value
End With
With Sheets("ダイジェスト")
.Cells.ClearContents
Rem 標準外書式セルをまとめて処理
.Range("C2:E3").NumberFormatLocal = "yyyy/m/d"
Rem 生データのセルをまとめて処理
.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 = "内訳概要"
.Range("A2:A3").Value = "〇〇〇株式会社 御中"
.Range("B2").Value = 1
.Range("C2").Value = 43198
.Range("D2").Value = 43222
.Range("E2").Value = 43251
.Range("F2:F3").Value = 23169
.Range("G2:G3").Value = 18535
.Range("H2:H3").Value = 20018
.Range("I2:I3").Value = "S4"
.Range("J2:J3").Value = "B27 等"
.Range("B3").Value = 2
.Range("C3").Value = 43191
.Range("D3").Value = 43192
.Range("E3").Value = 43221
End With
End Sub
’ここまで
（半平太） 2018/04/16(月) 09:28
先ほどから色々テストをしています。（そちらへのこのアップが２回、コメントアップ時にインターネットが
表示されないと
半平太さんが作られた照合番号１と２につきまして、
con から保存シートへの転記は、うまく行きました。（ダイジェストも）
（conのデータセル番地と保存シートへの１行目の各セルとを、一つ一つ照合しました。）
保存シートの列は、Ａ列からＢＺ列迄 、ダイジェストの列は、Ａ列からＪ列迄 です。
上手く行ったので、私は、照合番号、追加で３，４，５を作りました。
これもうまく行きました。
有難うございます。
次に下記呼出等の中で、呼出(一つ過去) と呼出(一つあと)だけが、上手く行かなかったです。
呼出(一つ過去)のメッセージは、これ以上過去取引は、ありません。
呼出(一つあと)のメッセージは、これ以上新しい取引はありません。と出ます。
（どちらもあえて前後のデータがあることを確認して呼出をしていますのに？）
新規
呼出(照会番号で)
呼出(取引先名で)
呼出(一つ過去)
呼出(一つあと)
呼出(直前保存分)
保存
そんな中で試行錯誤している最中、ふと平太さんが作成された照合番号１，２で再度（初回は、全ての
呼出等が上手く行っていました。）呼出等をしようと思い、実行しました。
そしたら、交互に呼出等をしましたら、呼出し"一つ過去"、と"一つあと" が上手く行きました。
理由は、わかりませんが 何かのヒントとなって修正出来れば良いと
思いまして。
どうぞよろしくお願いいたします。
（謙治） 2018/04/16(月) 17:16
＞先ほどから色々テストをしています。（そちらへのこのアップが２回、 ＞コメントアップ時にインターネットが表示されないと
回答者は、まとまったレスを書く場合は、 まずメモ帳に書き、それを保存しておいてから、コピー→アップロードしているのが普通です。 何かがあっても、メモ帳を保存してあれば、またコピーで対応できます。
＞次に下記呼出等の中で、呼出(一つ過去) と呼出(一つあと)だけが、上手く行かなかったです。 ＞呼出(一つ過去)のメッセージは、これ以上過去取引は、ありません。 ＞呼出(一つあと)のメッセージは、これ以上新しい取引はありません。と出ます。 ＞（どちらもあえて前後のデータがあることを確認して呼出をしていますのに？）
そこに何か勘違いがあるような気がします。
「過去」取引とか、「より新しい」取引とは、 今、conに表示されている取引先に限定した照会番号です。
その取引先と関係ない取引は、対象外になっているんですけども？
<con> 行 _______V_______ ____W____ _X_ 操作説明 ↓ 9 呼出(一つ過去) 入力不要 今表示されている取引先のもう一つ古い取引を見たい場合に左セルを右クリック 10 呼出(一つあと) 入力不要 今表示されている取引先のもうひとつ新しい取引を見たい場合に左セルを右クリック
全ての取引を順次みて行くなんてことは、需要がないと思っているんですけど・・・
担当者が切実に知りたいのは、「一つの取引先」について、過去やそのあとにどんな取引をしたか、だと思っているんですが・・？
あと、これ（新規取引処理の手順）については、どうですか？ ↓ ＞ ＞メニューにつきましての質問です。 ＞ ＞新規 ＝本来、どいう意味を持つのですか？ ＞ ＞（私のやり方が悪いかもしれませんが、新規番号を入力して右クリックしましたら照会番号だけ残り他の ＞ ＞データは消えます。） ＞ ＞ そちらの新規取引の入力方法は確認しなかったですが、 ＞ 「新規」なので新規照会番号をW6セルに入力後、V6セルを右クリックして、操作スタートとなると想定しています。 ＞ ＞ なので、照会番号以外は、新しい情報を入れるエリアなので全てクリアーしています。 ＞ 下手に以前のデータを残すと、ミスの元になりますので。 ＞ ＞ もしかして、全部データを入れてから、最後の方で新規の照会番号を入力するんでしょうか？
（半平太） 2018/04/16(月) 17:41
以後、そのようにしていきます。有難うございました。
＞あと、これ（新規取引処理の手順）については、どうですか？
あっ、すみません。伝えるのを忘れていました。
私の勘違いでした。すみませんでした。
色々試した結果、メニューで新規の行、Ｗ列に新規照会番号を入れ、Ｖ列を右クリックをするとconの表示にあるデータが消去され照会番号だけが入ります。
その後必要なデータを入力してします。→保存でうまく行き、おそがけながら、理解しました。
＞「過去」取引とか、「より新しい」取引とは、
今、conに表示されている取引先に限定した照会番号です。 その限定した照会番号を出したのは、過去、又は、より新しい、のメニューでエラーが起こるのですから
照会番号または、取引先名から呼び出したのですね。
それであれば過去又はより新しい取引先というメニューはどんな時に利用するのですか？
またそこも私の勘違いかもしれませんが。
その取引先と関係ない取引は、対象外になっているんですけども？
<con> 行 _______V_______ ____W____ _X_ 操作説明 ↓ 9 呼出(一つ過去) 入力不要 今表示されている取引先のもう一つ古い取引を見たい場合に 左セルを右クリック 10 呼出(一つあと) 入力不要 今表示されている取引先のもうひとつ新しい取引を見たい場合に 左セルを右クリック
全ての取引を順次みて行くなんてことは、需要がないと思っているんですけど・・・
＞担当者が切実に知りたいのは、「一つの取引先」について、過去やそのあとにどんな取引をしたか、
＞だと思っているんですが・・？
過去やそのあとにどんな取引をしたかを見るために、今表示されている取引先のもう一つ古い取引を見たい
場合に 9 呼出(一つ過去) をするのかと思っていました。
では、9 呼出(一つ過去) は、どんな場合に利用するのですか？
●>上述の通り、「呼出(取引先名で）」で最新版が出ますので、
>そのあと「呼出(ひとつ過去）」を右クリックして、「欲しい」取引データが出るまで、 >右クリックを続ける、と言うのが実際的だと思います。 （半平太） 2018/04/14(土) 15:14 ここで半平太さんがいうように、呼出(取引先名で、又は、照会番号で）でデータを出し、そのあと「呼出 (ひとつ過去）を右クリックしたのですが、そこでコメントとして、これ以上過去取引は、ありません。と 出ました。
私が、理解不足でお時間を取らせ申し訳なく思っています。
すみませんが、どうすればよいかを教えてください。
（謙治） 2018/04/16(月) 20:00
文章だけだと旨く伝えられていないような気がします。
２つの取引先があったとして、それぞれが過去に３つ、４つの取引があったとします。
取引先A 1/3 照会番号1 取引先A 2/5 照会番号3 取引先A 3/6 照会番号6
取引先B 1/6 照会番号2 取引先B 2/7 照会番号4 取引先B 2/25 照会番号5 取引先B 4/1 照会番号7
例えば、4月10日に担当者が取引先Bの2/7に見積った取引を納品したい場合 照合番号がNo.4であることが分かっていれば、「呼出（照会番号で）」で行けますが、
取引先Bで2/7に見積もった取引と云う情報だけで、No.4を出したいと思った時は、 まず、「呼出（取引先名で）」で、最新版の4/1を呼出した後、 「呼出（一つ過去）」で一回右クリックすると、2/25のが現れるが、それじゃないので、 もう一回右クリックすると、2/7のが現れるので、納品書作り作業に入れる。 進捗度2に変更したりして、印刷する、とかやって、保存をクリック・・と言う流れです。
つい、右クリックが行き過ぎて1/6のになった場合は、「いけねぇ。いけねぇ」なんていいながら 「呼出（一つあと）」で戻る。
・・と言った感じです。
その時、取引先Aの取引もずらずら現れたら、多すぎて、右クリックする手首が腱鞘炎になりますし、 もし、取引先Aも同じ日付の取引があったりでもしたら、取り違えるおそれもあります。 なので、同じ取引先についてだけの過去への遡りなんです。
・・そんな意味なんですけど、謙治さんは、同じ認識の上で、 あるハズの取引が、「過去にない」とか、「もうあとは無い」とか メッセージが出ると主張されているんですか？
（半平太） 2018/04/16(月) 20:33
〉「過去にない」とか、「もうあとは無い」とか
メッセージが出ると主張されているんですか？ 一方的な主張しているのではなく、このようなエラーメッセージが 出ているので、解決法を教えて欲しかっただけです。
〉同じ取引先についてだけの過去への遡りなんです
これで、理解しました。
明日試します。今、気づきました。
私の3件追加をした取引先名は、
同じ取引先が無かったように思われます。
今、かくにんは、出来ませんので後で確認して、
同じ取引先を追加して確認します。
本当に、すみませんでした。
また連絡します。
（謙治） 2018/04/16(月) 20:53
＞同じ取引先についてだけの過去への遡りなんです。
＞私の3件追加をした取引先名は、
＞同じ取引先が無かったように思われます。
今、確認しましたら同じ取引先はなかったので、2件ほど同じ取引先名Ａを保存に追加してから、
conに取引先名Ａの照会番号を入力して取引先名Ａを呼出した後、一つ過去と一つあとを交互に呼び出しましたら、どちらも取引先名Ａをうまく呼び出すことが出来ました。
私は、メニューの説明（Ｙ列）で、"今表示されている取引先のもう一つ古い取引を見たい場合に左セルを右クリック" と書かれている今表示されている取引先を、同じ取引先とは、思っていなかったです。
どこかの説明で聞いていたかもしれませんが‐‐‐ご迷惑をかけてすみませんでした。
これで、一つ過去と一つあとを呼出す意味が理解できました。
遅くなりましたが、改めて下記の呼出等が全てうまくいったことを確認しました。
新規
呼出(照会番号で)
呼出(取引先名で)
呼出(一つ過去)
呼出(一つあと)
呼出(直前保存分)
保存
次は、どのように進んで行けばいいのですか？
（謙児） 2018/04/16(月) 23:00
＞次は、どのように進んで行けばいいのですか？
そう言われるとちょっと困ります。
私自身が使う立場なら、もっと追加機能を付加します。
けど、ここは単なるQ＆Aであって、有料のヘルプデスクじゃないですからねぇ。
そちらの当初の目的「見積書・納品書・請求書の追加作成」が 達成出来たと認識された時点で本件終了です。
１．本番で使って下さいと言うぐらいです。
２．本来は、実務担当者レベルでもテスト使用し、 そこで出た不具合、使い勝手の改善を行ってから本番移行となります。
私としては、不具合は対応しますが、それ以外にお応えするかは、 その時の気分と内容次第と云うしかないです。
３．本番移行をどうするかは、謙児さんサイドで解決する課題となります。
（1）新しい操作方法を周知する・・のは当然として
（2）既に発生している取引のデータ、それは多分カルテ型のデータベースなんでしょうが、 それを1件1行のデータペースに再構築する必要があります。
人海戦術で新システムに再入力して、保存シートとダイジェストシートを作り上げるのか？ 何らかの変換システムを作って、サクッとデータ移行できる様にするのか？。
・・と突き放すのもちょっと気が引けますが、 既存データがどうなっているか、何件ぐらいが生きていて、どんなデータの持ち方をしているのか 私はよく分かりませんからねぇ。
（多分、前回、関わった回答者も分かってないと思いますよ）
そんな状態じゃ、何ともしようがないも現実です。
（半平太） 2018/04/17(火) 00:08
＞次は、どのように進んで行けばいいのですか？
私がこのように書いたのは、（半平太さんの） 2018/04/16(月) 20:33付けで、
下記コメントで最後になっていました。そしてこの問題が解決したので、
半平太さんが、次にこれを試して下さいとかがあるのかと思ってお聞きしただけです。
＞・・そんな意味なんですけど、謙治さんは、同じ認識の上で、
＞ あるハズの取引が、「過去にない」とか、「もうあとは無い」とか
＞ メッセージが出ると主張されているんですか？
私の方では、conシートから保存シートへの転記とメニュー等がうまく行けば、次に
納品書と請求書の保存の仕方を聞くつもりで、当初から思っていましたが、途中私の理解不足で、
半平太さんに時間を取らせてしまい、それどころではなかったので、落ち着いたらきくつもりでした。
＞そちらの当初の目的「見積書・納品書・請求書の追加作成」が
＞達成出来たと認識された時点で本件終了です
私は、いまの時点で達成出来たとは思っていません。
その理由は、最後の質問にあります。
＞２．本来は、実務担当者レベルでもテスト使用し、
＞ そこで出た不具合、使い勝手の改善を行ってから本番移行となります。
はい、わかりました。実務担当者になるべく早くテストをしてもらいますので、
申し訳ございませんが、それまで、お待ちください。
（実務担当者（よく使う人に）には、以前データ項目について変更はないですかと確認をして
了解をもらっています。後は、半平太さんが作って頂いた保存、メニュー等で誰が使っても
便利なものですから、説明をすれば喜んで使って頂けると思っています、
ですから、担当者がテストをして仮に不都合を訴えるなら、今まで私の不手際で、
データ箇所の変更を何回かにわかって半平太さんに手直ししていただいているので
もうこれ以上ご迷惑をかけたくなかった為に、担当者にこちらのやり方になれて頂くつもり
でした。）
＞ 2）既に発生している取引のデータ、それは多分カルテ型のデータベースなんでしょうが、
＞ それを1件1行のデータペースに再構築する必要があります。
カルテ型のデータベースとはなんですか？ データベースに再構築する必要がありますとは
具体的に何をどうすることなんでしょうか？
半平太さんがテスト的に作られた照会番号１，２の続きで私が追加した照会番号３から５で
結果うまく行きましたのでその続きで、作成しては、いけないのでしょうか？
＞ 人海戦術で新システムに再入力して、保存シートとダイジェストシートを作り上げるのか？
＞ 何らかの変換システムを作って、サクッとデータ移行できる様にするのか？。
人海戦術で新システムに再入力して、とは、新システムになるまでの紙ベースで出来た
データのことでしょうか？
＞ 既存データがどうなっているか、何件ぐらいが生きていて、どんなデータの持ち方をしているのか
＞ 私はよく分かりませんからねぇ。
その既存データとは、このサイトで見積書の転記を質問する前に、弊社の担当者が
作成していた見積書・納品書・請求書の事をいうのでしょうか？
もしそのことであれば、今までは、担当者は、エクセルで作成したものを保存していますし
紙で印刷して共通の紙ファイルに保管しています。
過去とは、切り離して考えますので、今回のエクセルＶＢＡのファイルにのせなくても大丈夫です。
質問：改めてですが、納品書と請求書のデータは、ほとんど（決まり文句の違いはありますが）
保存シートから呼出して納品書又は請求書の各データ箇所に式=conで使用出来ますが、担当者が、
過去の納品書又は請求書を見たいという場合に、各保存の仕方を教えて頂きたかったのです。
ただ私が考えるに、
１、過去の請求書を見たい場合は、（照会番号は、納品書と請求書を一緒にしていますので）例えば、
照会番号１１１の請求書を見たければ、conシートで１１１を呼び出します。
読んだデータは、請求書の各データ箇所に＝conで うまく行きます。
となれば、納品書と請求書を保存する方法を考えるより上記１、を利用して担当者に理解を求めた方が
よろしいでしょうか？
○ 質問ですが、納品書、請求書のフォームは、シート名を納品書と請求書の2つに分けるのが
良いか？一つのシートで横列に並べて 各データを=con にするのが良いか？
どちらも後で問題は、起きませんでしょうか？）
以上ですが、よろしくお願いいたします。
もうかなりご負担になっていると推察いたしますが、もう少しお付き合い下さい。
突き放さないでください。（笑）
（謙児） 2018/04/17(火) 10:00
＞○ 質問ですが、納品書、請求書のフォームは、シート名を納品書と請求書の2つに分けるのが
良いか？一つのシートで横列に並べて 各データを=con にするのが良いか？
どちらも後で問題は、起きませんでしょうか？）
この質問で、一つのシートで、とは、実際に印刷する見積書の事です。
（謙児） 2018/04/17(火) 11:49
そしたら、上記だけの表示ですか？それとも他に表示されるものがあるのでしょうか？
活用方法をお聞きしています。
（謙児） 2018/04/17(火) 13:05
＞半平太さんが、次にこれを試して下さいとかがあるのかと思ってお聞きしただけです。
いや、問題視されなくなったのなら、追試は必要ありません。
＞私の方では、conシートから保存シートへの転記とメニュー等がうまく行けば、次に ＞納品書と請求書の保存の仕方を聞くつもりで、当初から思っていましたが、途中私の理解不足で、 ＞半平太さんに時間を取らせてしまい、それどころではなかったので、落ち着いたらきくつもりでした。 ＞私は、いまの時点で達成出来たとは思っていません
そうだったんですか。この件については下の方で論議したいです。
＞実務担当者になるべく早くテストをしてもらいますので、 ＞申し訳ございませんが、それまで、お待ちください。
そんなに焦らなくても、こっちはまだ余裕があります。 そちらのペースで進めてください。
＞担当者がテストをして仮に不都合を訴えるなら、今まで私の不手際で、 ＞データ箇所の変更を何回かにわかって半平太さんに手直ししていただいているので ＞もうこれ以上ご迷惑をかけたくなかった為に、担当者にこちらのやり方になれて頂くつもり ＞でした。
そんなに気を使わなくてもいいですよ。気が進まないものはお断りするだけですから。
＞カルテ型のデータベースとはなんですか？ データベースに再構築する必要がありますとは ＞具体的に何をどうすることなんでしょうか？
カルテ型とは以前の質問にあったような、 1件の取引を縦横に複数配置した病院のカルテのようなデータ保管方法です。
カルテ型（一件一頁） 行 ___A___ ____B____ ____C____ ____D____ _____E_____ 1 患者名 仮病月男 2 入院日 2018/4/17 3 病名 虚言癖 4 検査済み うそ発見器 5 寿命 あと少し
再構築（一件一行） 行 ____A____ ___B___ ___C___ _____D_____ ____E____ 1 患者名 入院日 病名 検査済み 寿命 2 仮病月男 2018/4/17 虚言癖 うそ発見器 あと少し
＞ 半平太さんがテスト的に作られた照会番号１，２の続きで私が追加した照会番号３から５で ＞ 結果うまく行きましたのでその続きで、作成しては、いけないのでしょうか？
正にそれがいいんです。 既存データを間違いなく再配置する、と言う意味です。
＞過去とは、切り離して考えますので、今回のエクセルＶＢＡのファイルにのせなくても大丈夫です。
そうなんですか？ それだと、移行のことは心配しないで済みますので、大きな懸念事項の一つが減りますね
＞ただ私が考えるに、 ＞１、過去の請求書を見たい場合は、（照会番号は、納品書と請求書を一緒にしていますので）例えば、 ＞ 照会番号１１１の請求書を見たければ、conシートで１１１を呼び出します。 ＞ 読んだデータは、請求書の各データ箇所に＝conで うまく行きます。 ＞ ＞ となれば、納品書と請求書を保存する方法を考えるより上記１、を利用して担当者に理解を求めた方が ＞ よろしいでしょうか？
それは、謙児さんの当初の構想通りなんじゃないですか？ こちらも、その前提で考えていましたので、納品書と請求書はことさらデータ保存は考えておりません。
ただ、頭の片隅にあるのは、本当に同じなの？ ってことなんです。 少なくとも、発行日も同じハズはないと思ったのですが、 アバウトでいい会社なんだなとして、スルーしていました。
＞ ○ 質問ですが、納品書、請求書のフォームは、シート名を納品書と請求書の2つに分けるのが ＞ 良いか？一つのシートで横列に並べて 各データを=con にするのが良いか？ ＞ どちらも後で問題は、起きませんでしょうか？） ＞ この質問で、一つのシートで、とは、実際に印刷する見積書の事です。
一長一短ですね。担当者の意見が大きいです。 私個人としては、横に広すぎるのはいやなので、シート分別の方がいいです。
私の関心事は、請求書を印刷するときに、 呼び出すだけで、本当に何のデータ変更もしないのですか？ と言うことですね。
もし、データの入力(または変更）を行うなら、 それは何なのか、それは保存しなくていいデータなのか、それが分からないと私は不安です。
今のところ、変更するのは進捗度だけと認識されるので、これは既に保存対象なので不安がありません。 あるとすれば、進捗度を変更し忘れることですね。
＞シート名：サブリストの Ｃ列１行目は、conシート名：の現在表示されている取引名ですね。 ＞そしてＣ列２行目は、その照会番号ですね。 ＞そしたら、上記だけの表示ですか？それとも他に表示されるものがあるのでしょうか？ ＞活用方法をお聞きしています。
他はないです。 以下の３セルが右クリックされる都度、C列のリストを瞬時に作り直して、「最後尾、現在より前、後」を判断させるのに使っています。
呼出(取引先名で) 呼出(一つ過去) 呼出(一つあと)
（半平太） 2018/04/17(火) 15:12
この質問通り、当初、私も納品書・請求書の発行日等が見積書と違うため、各発行日記載後の保存を
する必要があると思っていた事をわすれていました。
言われて気づきました。すみません。
＞ もし、データの入力(または変更）を行うなら、
＞ それは何なのか、それは保存しなくていいデータなのか、それが分からないと私は不安です。
最初に納品書と請求書のフォームを作っていたファイルを見つけて見積書とのデータの違いを
把握してからお返事します。
＞一長一短ですね。担当者の意見が大きいです。
＞私個人としては、横に広すぎるのはいやなので、シート分別の方がいいです。
わかりました。
＞他はないです。
＞ 以下の３セルが右クリックされる都度、C列のリストを瞬時に作り直して、「最後尾、現在より前、後」を＞判断させるのに使っています。
はい、わかりました。有難うございました。
（謙児） 2018/04/17(火) 16:25
conシートを基盤に見積書、納品書、請求書の
各データの式は、=con各データとなっています。
言われますように、納品書、請求書の発行日付が異なりますので、簡単に言うつもりでは
ありませんが、各発行日付を記入した時点で保存ができますようにお願い出来ませんでしょうか？
担当者に各フォーマットのデータ項目がこれで良いかどうかを確認をしましたが、
大丈夫の許可をもらいましたので、
納品書、請求書の発行日保存以外には、修正はありません。
以上ですが、よろしくお願いいたします。
（謙治） 2018/04/20(金) 18:16
納品場所 と納期、本見積有効期限 のデータ箇所は、お分かりのように必要ないですから
表示していません。
後は、直接データとは関係ないですが、例えば、請求書なら ｘｘ月分の請求です。よろしくお願いいた
します。 とか弊社の銀行口座の表示等を入れています。
（謙児） 2018/04/20(金) 19:22
＞納品書、請求書の発行日付が異なりますので、 ＞各発行日付を記入した時点で保存ができますようにお願い出来ませんでしょうか？
１． 見積書の発行日は P6,R6,T6 にありましたので、 「納品書」・「請求書」も、それぞれのシートの同じ位置ですね？
２．あと、メニューの改善なんですけども、 「新規」を右クリックしたとき、照会番号以外のセルは全てデータをクリアするように作ってはあります。
でも例えば、ある取引先の過去データをチェックして、「よし！ この取引先だ」と確認して、 新規を右クリックすると、折角、埋まっっていたデータが全部クリアになると寂しい気持ちになるような気がします。
「あーあ、さっきのデータの一部はそのまま使えたのになぁ」なんて・・
そんなボヤキが担当者から出なかったですか？
ここは、なんか改善した方がいいと思っているんですが・・・
（半平太） 2018/04/20(金) 19:49
あと、納品書の発行日付を入れて、印刷したあと、 操作者は「conシートに戻って、保存する」と言う手順は 問題なく守られるんでしょうか？
なんか忘れられそうな気がするんですけども。
なので、納品書や請求書には保存ボタンが必要かな？と思っているのですが、 そちらで自力対応できますか？
（半平太） 2018/04/20(金) 19:55
戻ってとなりますと、おっしゃる通り
問題が、ありますね。
私のイメージでは、納品書、請求書の印刷後、
各書類に、ボタンがあって、ボタンを押すと
登録され、その登録が、conシートの保存の同じ照会番号に
貼り付けされる(事前に保存シートの列に納品発行日、請求発行日
を設けておいて。）ようになれば、使用者は、
面食らう事が無くなるのでは、と思いました。
でもVBAは、出来ませんから、お力をおかりしたいですが。
イメージを書きましたが、気持ちは、半平太さんと一緒にして
いきたいと思って書きました。
（謙治） 2018/04/20(金) 20:37
2018/04/20(金) 19:49 でお聞きしている事柄の方はどうですか？
（半平太） 2018/04/21(土) 07:57
＞（半平太さん） 2018/04/20(金) 19:49
気づかなかったです。すみませんでした。
＞１． 見積書の発行日は P6,R6,T6 にありましたので、
＞「納品書」・「請求書」も、それぞれのシートの同じ位置ですね？
午後から会社に行きますので、その後確認します。
（基本、見積書に発行日他も一緒に合わせていますが、以前、conシート の列を修正してから色々教えて
頂いている間、納品書と請求書のフォームは、落ち着いてから修正すればいいと考えていました。
最近、納品書と請求書の列もconシートに合わせました、正しいセル番地を確認しますので‐‐‐、
そのファイルは、会社にあります。）
＞２．あと、メニューの改善なんですけども、
「新規」を右クリックしたとき、照会番号以外のセルは全てデータをクリアするように作ってはあります。 ＞でも例えば、ある取引先の過去データをチェックして、「よし！ この取引先だ」と確認して、 ＞新規を右クリックすると、折角、埋まっっていたデータが全部クリアになると寂しい気持ちになるような気＞がします。
その通りですね。過去のデータですから、当人が、保存を使えばよさそうなものですし、新規を押すと
"新しい番号を入れて下さい"と出た時に気づくと思いますが。しかし色々している時に、
誤って新規を押す人も無きにしも非ずですね。私も説明は、箇条書きにまとめて用意していますが、
新規と保存等の区別を理解してもらうような説明、ないし口頭で伝えることが必要ですね。
アイデアですが、"新しい番号を入れて下さい"の続きに"番号以外のデータは消えます、yes or no"と入れて頂ければ防ぐことが出来るのではないでしょうか？
＞そんなボヤキが担当者から出なかったですか？
その場面はなかったですね。
以上です。
有難うございました。
午後までお待ちください。
（謙児） 2018/04/21(土) 09:18
conシートの列を少なくしたときに、納品書と請求書のシートを削除していました。
後にシートを追加しただけでした。（中身のデータは、記載していませんでした。）
まして現在の見積書の列は、最初の沢山の列があったままになっていまして、その見積書の各データは、
=con 各データとなっています。（見積書シートは、印刷範囲が、全体の調整がとれていて見積書の各データ
=con 各データになっているから、そのままにしておこうという思いがありました。
改めて見積書と納品書と請求書の列は、なるべく早くconの列と同じにします。
＞「納品書」・「請求書」も、それぞれのシートの同じ位置ですね？
conシート の発行日と同じように P6,R6,T6 に揃えますので、
それを前提で考慮していただいて結構ですのでよろしくお願いいたします。
（謙治） 2018/04/21(土) 14:27
＞=con 各データになっているから、そのままにしておこうという思いがありました。
それで全然かまわないです。 （その方がそちらの手間が掛からないですから）
こちらは、どのセルなのか確定して頂ければいいです。どこのセルであっても、手間は一緒なので。
（半平太） 2018/04/21(土) 15:55
続いてよろしくお願いします。
（謙治） 2018/04/21(土) 17:40
こちらは、どのセルなのか確定して頂ければいいです。 納品書と請求書の発行日を後で知らせます。
（謙治） 2018/04/21(土) 18:21
納品書と請求書の発行日のセルは、年のデータ（ＡＥ６）、月のデータ（ＡＧ６）、
日のデータ（ＡＩ（あい）６）です。
請求書のフォームをアレンジしている時に、気づいたのですが、
文面で、"下記のとおりｘｘ月分のご請求を申し上げます。
のところでｘｘを一つのセルにしています。（月だけを入れやすくするために）
そのｘｘのセルが Ｅ１６です。
私が気づくのが遅く申し訳ありませんが、
請求書を保存する時に発行日付と共にｘｘも保存が必要になりますので、
すみませんが、よろしくお願いいたします。
（謙児） 2018/04/21(土) 23:51
１．ざっと、以下の処理が必要になりますので、。 後記３-（1）の「タイトルとアドレス修正および名前定義追加」マクロを1回だけ実行してください。
（1）名前定義の追加 （2）保存シートのタイトル（1行目）の修正
２．新規メニューの使い勝手を以下の通り改善します。
新規の右クリックしたら、操作者の意向を聞いて、以下の3つに分岐できるようにする
（1）全てクリアする (純粋新規）
（2）日付と明細(見積内訳)と進捗度 だけクリアする (それ以外は、現在表示されている(過去)のデータを生かして新規処理したい時）
（3） conはそのままにして、「納品書と請求書の発行日付」、「納品書のx月分」だけクリアする (先に新規の諸データを入れたので、そのデータを生かして新規処理したい時)
３．プログラムは色んな部分を修正したので、全面差し替えにします。 以前のプログラムは完全に消去してください。
以下、差し替え用のプログラムです
３-（1）適当な標準モジュールに以下を貼り付け実行 （実行は1回だけ）
’ここからーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Option Explicit
Sub タイトルとアドレス修正および名前定義追加() '一回実行すれば、消去してよし
Dim Cel As Range
初期値設定
'保存範囲のアドレス情報修正（CON一行目）
With WshDSTN
For Each Cel In .Range("A1:BZ1") '頭にcon
Cel.Value = "con" & Cel.Value
Next Cel
'追加アドレス書き足し
.Range("CA1").Value = "納品書AE6"
.Range("CB1").Value = "納品書AG6"
.Range("CC1").Value = "納品書AI6"
.Range("CD1").Value = "請求書AE6"
.Range("CE1").Value = "請求書AG6"
.Range("CF1").Value = "請求書AI6"
.Range("CG1").Value = "請求書E16"
.Range("CA2").Value = "納品日"
.Range("CD2").Value = "請求日"
.Range("CG2").Value = "月分"
End With
'アドレス情報修正（ダイジェスト一行目）
With WshDJT
.Range("K1").Value = "納品書発行日付"
.Range("L1").Value = "請求書発行日付"
.Range("M1").Value = "請求書月分"
End With
'名前定義追加
With WshSRC
.Range("O5,P6,R6,T6,B7,B8,B10,P8,O10,E19,F20,H20,J20,F21,H21,J21,S4").Name = "必須データ"
.Range("P6,R6,T6,F20,H20,J20,F21,H21,J21,B27:B44,N27:O44,B46:B49,S4").Name = "明細"
'メニュー、一部表現を修正
.Range("V9").Value = "呼出(同名で一つ過去)"
.Range("V10").Value = "呼出(同名で一つあと)"
End With
WshDLVR.Range("AE6,AG6,AI6").Name = "納品書日付"
WshPAY.Range("AE6,AG6,AI6,E16").Name = "請求書日付月分"
End Sub
’３-（1）ここまで −−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
３−（2）ア. 「共通」モジュールに ’ア ここから＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Option Explicit
Public Enum 保 'WshDSTN
照番 = 1
取引先番 = 8
End Enum
Public Enum サブ 'WshSLT
照番 = 1
取引先番 = 2
個別照番 = 3
End Enum
Public WshSRC As Worksheet 'CON Public WshDSTN As Worksheet '保存 Public WshSLT As Worksheet 'サブリスト Public WshDJT As Worksheet 'ダイジェスト Public WshDLVR As Worksheet '納品書 Public WshPAY As Worksheet '請求書
Public rngAddresses As Range 'アドレス格納範囲 Public preProcCell As Range '前回処理名のセル Public refNoCell As Range Public custNameCell As Range Public preRefCell As Range
Public Const AreaCon As String = "保存範囲" Public Const AreaAll As String = "保存範囲,納品書日付,請求書日付月分" Public Const AreaDetails As String = "明細,納品書日付,請求書日付月分" Public Const AreaDateDELnPAY As String = "納品書日付,請求書日付月分" Public Const AreaEssential As String = "必須データ"
Sub 初期値設定()
Dim clearScope As String
Set WshSRC = Sheets("CON")
Set WshDSTN = Sheets("保存")
Set WshSLT = Sheets("サブリスト")
Set WshDJT = Sheets("ダイジェスト")
Set WshDLVR = Sheets("納品書")
Set WshPAY = Sheets("請求書")
Set rngAddresses = WshDSTN.Range("A1", WshDSTN.Cells(1, 10000).End(xlToLeft))
Set preProcCell = WshSRC.Range("V5")
Set preRefCell = WshSRC.Range("W11")
Set refNoCell = WshSRC.Range("O5")
Set custNameCell = WshSRC.Range("B10")
End Sub
'１列内に存在する位置
Function RwNum(ByVal KEY, ByRef TargetWsh As Worksheet, ByVal 列 As Long) As Variant
RwNum = Application.Match(KEY, TargetWsh.UsedRange.Columns(列), 0)
End Function
'１列内に存在する該当数
Function numMatches(TargetWsh As Worksheet, ByVal 列, ByVal KEYToCheck) As Variant
numMatches = Application.CountIf(TargetWsh.UsedRange.Columns(列), KEYToCheck)
End Function
Sub clearAreaByCase(ByVal clearArea As String)
Dim strA, ar As Range
For Each strA In Split(clearArea, ",")
For Each ar In Application.Range(strA)
ar.MergeArea.ClearContents
Next ar
Next strA
End Sub
Function 履歴呼出成否(ByVal KEY) As Boolean
Dim Rw
Dim Cel As Range
Dim ValToBack
Dim adr
履歴呼出成否 = True
Select Case numMatches(WshDSTN, 保.照番, KEY)
Case 0
MsgBox "当該照合番号は存在しません"
履歴呼出成否 = False
Exit Function
Case Is > 1
MsgBox "当該照合番号が保存シートに重複しています。原因を調査してください。"
履歴呼出成否 = False
Exit Function
Case Else '1個のみ該当
Rw = RwNum(KEY, WshDSTN, 保.照番)
Application.ScreenUpdating = False
'全保存範囲を先行してクリアする (呼出データがEmptyの場合は､書込みに行かないので必要な処理)
Call clearAreaByCase(AreaAll)
For Each Cel In rngAddresses '埋戻アドレスを順次取得
ValToBack = Cel(Rw, 1).Value '保存したデータを取得
If Not IsEmpty(ValToBack) Then '保存データが入っていれば
adr = Right(Cel.Value, Len(Cel.Value) - 3) 'アドレス(シート名なし)
ValToBack = Cel(Rw, 1).Value '戻すべきデータを取得
Select Case Left(Cel, 3) '1行目にあるアドレスを左3桁(シート名)をチェック
Case "納品書": WshDLVR.Range(adr) = ValToBack '該当アドレスに埋め戻す
Case "請求書": WshPAY.Range(adr) = ValToBack
Case Else: WshSRC.Range(adr) = ValToBack
End Select
End If
Next
Application.ScreenUpdating = True
End Select
End Function
Function isSufficiantData() As Boolean '入力必須データの確認
Dim Cel
isSufficiantData = True
For Each Cel In Application.Range(AreaEssential).Areas
If Application.CountBlank(Cel) > 0 Then
isSufficiantData = False
MsgBox "データが不足しています（例えば" & Cel.Address(0, 0) & "セル）"
Exit Function
End If
Next
If Not IsNumeric(WshSRC.Range("D14")) Then
isSufficiantData = False
MsgBox "見積額欄が不正です。処理を中止します。"
Exit Function
ElseIf WshSRC.Range("D14") = 0 Then
isSufficiantData = False
MsgBox "見積額欄が0円です。処理を中止します。"
Exit Function
End If
End Function
Function getCustKEYbyPos(ByVal CustName, ByVal KEY, ByVal sPos As String)
Dim KEYS, Pos As Long
KEYS = getKEYsByCustName(CustName)
Select Case sPos
Case "Latest"
getCustKEYbyPos = KEYS(UBound(KEYS) - 1, 1) '最後尾はEmptyなので
Case "Backwards"
Pos = Application.Match(KEY, KEYS, 0)
getCustKEYbyPos = KEYS(Pos - 1, 1)
Case "Forwards"
Pos = Application.Match(KEY, KEYS, 0)
getCustKEYbyPos = KEYS(Pos + 1, 1)
End Select
End Function
Function getKEYsByCustName(ByVal CustName) '一つの取引先の照会番号一覧を作成して、最新照合番号をゲット
Dim dicT As Object
Dim Rw As Long, srcValKEY, srcValName
srcValKEY = WshDSTN.UsedRange.Columns(保.照番).Value '照会番号列
srcValName = WshDSTN.UsedRange.Columns(保.取引先番).Value '取引先名列
Set dicT = CreateObject("Scripting.Dictionary")
dicT(CustName) = Empty
For Rw = 3 To UBound(srcValName) '照会番号列（タイトル行を避ける）
If srcValName(Rw, 1) = CustName Then
dicT(srcValKEY(Rw, 1)) = Empty
ElseIf IsEmpty(srcValName(Rw, 1)) Then
Exit For
End If
Next Rw
Call 出力ソート(dicT, 3) 'dicTのキーを3列目に出力
dicT.RemoveAll
With WshSLT
getKEYsByCustName = .Range(.Cells(1, サブ.個別照番), _
.Cells(.Rows.Count, サブ.個別照番).End(xlUp).Offset(1)).Value
End With
End Function
Private Sub 出力ソート(ByRef dicT, ByVal COLout As Long)
Application.ScreenUpdating = False
With WshSLT
.Columns(COLout).ClearContents
.Cells(1, COLout).Resize(dicT.Count, 1).Value = Application.Transpose((dicT.KEYS))
With .Sort
.SortFields.Clear
.SortFields.Add KEY:=.Parent.Cells(2, COLout), SortOn:=xlSortOnValues, Order:=xlAscending
.SetRange .Parent.Cells(1, COLout).Resize(dicT.Count)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlStroke
.Apply
End With
End With
Application.ScreenUpdating = True
End Sub
Sub StoreDataFromOtherThanCON()
Sheets("con").storeFromDLVRorPAY
End Sub
’’３-（2）ア ここまで＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
'３−（2）イ.「事前チェック」モジュールに 'イ. ここから@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Option Explicit
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(WshDSTN, 保.照番, KEY) > 0 Then
MsgBox "その照会番号は既に存在します"
Exit Function
End If
callable新規 = True
End Function
Function callable呼出指定(ByRef Target As Range, ByVal strAdrToFil) As Boolean
Dim KEY
Dim DefMsg
If isPreNewOK = False Then Exit Function
KEY = Target.Offset(, 1).Value
If IsEmpty(KEY) Then
If Target.Row = 7 Then
DefMsg = "セルに「照会番号」を入れてください"
ElseIf Target.Row = 8 Then
DefMsg = "セルに「取引先名」を入れてください"
Else
DefMsg = "セルにあるべき照会番号がありません。"
End If
MsgBox strAdrToFil & DefMsg
Exit Function
End If
callable呼出指定 = True
End Function
Function callable呼出自動(ByRef Target As Range, ByVal rngrToCheck As Range) As Boolean
Dim KEY, PosOfRefNo
If isPreNewOK = False Then Exit Function
KEY = rngrToCheck.Value
If IsEmpty(KEY) Then
MsgBox rngrToCheck.Address(0, 0) & "セルにデータがありません"
Exit Function
ElseIf IsEmpty(refNoCell) Then
MsgBox refNoCell.Address(0, 0) & "セルにデータがありません"
Exit Function
Else '取引先名、照合番号ｎ存在確認
If Application.CountIf(WshDSTN.Columns("H"), KEY) = 0 Then
MsgBox KEY & "と云う取引先はまだ存在しません"
Exit Function
ElseIf Application.CountIf(WshDSTN.Columns("A"), refNoCell) = 0 Then
MsgBox refNoCell.Value & "と云う照合番号はまだ存在しません"
Exit Function
Else
PosOfRefNo = Application.Match(refNoCell.Value, WshDSTN.Columns("A"), 0)
If WshDSTN.Cells(PosOfRefNo, "H").Value <> KEY Then
MsgBox "その取引先には、その照合番号の取引が存在しません"
Exit Function
End If
End If
End If
callable呼出自動 = True
End Function
’イ ここまで @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
３-（2）ウ.「con」シートモジュールに ’ウ. ここから \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Option Explicit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim KEY, KEYS, i As Long
Dim CustName, RefNo
Dim msg, ans
Dim goAhead As Boolean
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 '事前チェック
End If
Do
msg = "クリアするデータ範囲を「番号」で指定してください" & vbCrLf & vbCrLf & _
"1 = 全クリア（純粋新規）" & vbCrLf & _
"2 = 日付・明細・進捗度のみクリア（顧客情報は残す）" & vbCrLf & _
"3 = 納品・請求日付のみクリア（conデータは全て残す）"
ans = InputBox(msg, "", 2)
If ans = "" Then 'キャンセルされた
Exit Sub
End If
goAhead = InStr("-1-2-3-", "-" & ans & "-") > 0
Loop Until goAhead
'指定範囲を先行クリアする
clearAreaByCase (Array(AreaAll, AreaDetails, AreaDateDELnPAY)(CLng(ans) - 1))
'照会番号と進捗度は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, "W11") = 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 MsgBox("保存します。よろしいですか？", vbOKCancel) = vbCancel Then
Exit Sub
ElseIf isSufficiantData = False Then
Exit Sub
ElseIf was保存Done = False Then
Exit Sub
End If
Call was保存Digest 'ダイジェストにも書込み
preRefCell.Value = refNoCell.Value
preProcCell.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
Dim adr
KEY = refNoCell.Value '照合番号
Rw = RwNum(KEY, WshDSTN, 保.照番)
If IsNumeric(Rw) Then 'KEYが存在する→上書き保存しかない
If preProcCell.Value = "新規" Then '矛盾
MsgBox "その照会番号は、既に存在しています。新規ではありません"
Exit Function
Else
msg = "上書き保存しました" 'メッセージを先にセットする
End If
Else '新規
msg = "新規保存しました"
Rw = WshDSTN.Cells(WshDSTN.Rows.Count, "A").End(xlUp).Row + 1
End If
ReDim ValToFil(1 To 1, 1 To rngAddresses.Columns.Count)
'保存データを収集する
COL = 0
For Each adr In Split(AreaAll, ",")
For Each Cel In Application.Range(adr)
COL = COL + 1
ValToFil(1, COL) = Cel.Value
Next Cel
Next
WshDSTN.Cells(Rw, 1).Resize(1, UBound(ValToFil, 2)).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, WshDJT, 2)
If Not IsNumeric(Rw) Then
Rw = WshDJT.Cells(WshDJT.Rows.Count, "A").End(xlUp).Row + 1
End If
ReDim ValToFil(1 To 1, 1 To 13)
With WshSRC 'con
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
ValToFil(1, 11) = DateRemade(WshDLVR.Range("AD6:AJ6")) '納品書の発行日付
ValToFil(1, 12) = DateRemade(WshPAY.Range("AD6:AJ6")) '請求書の発行日付
ValToFil(1, 13) = WshPAY.Range("E16") '請求書のxx月分
WshDJT.Cells(Rw, 1).Resize(1, 13).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)
If Err.Number <> 0 Then
DateRemade = str
End If
On Error GoTo 0
End Function
Public Sub storeFromDLVRorPAY()
Dim CAN As Boolean
If ActiveSheet.Name = "納品書" Or ActiveSheet.Name = "請求書" Then
Call Worksheet_BeforeRightClick(Sheets("con").Range("V12"), CAN)
End If
End Sub
’３−（2）ウ. ここまで \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
４. 最後に手作業で、納品書シートと請求書シートに「保存ボタン」を追加してください。
エクセルのフォームコントロールボタンを貼り付け 当該ボタンの上を右クリックすると出てくるショートカットメニューの中から「マクロの登録」を選び、 マクロ名「StoreDataFromOtherThanCON」を指定してください。
以上です
（半平太） 2018/04/22(日) 16:06
先程上記コメントを見ました。
沢山のコードを記入していただき（たぶん、色々なチェックをされたと思います。
時間をおかけして申し訳ありませんでした。）有難うございました。
今からコードを入れ替え作業をしていきます。
とりあえず、コード処理が出来てからでは、遅くなりますので、先にお礼をと思いまして‐‐‐
（謙児） 2018/04/22(日) 18:31
黄色が 下記コードのwith WshDSTNに付きます。
Sub タイトルとアドレス修正および名前定義追加() '一回実行すれば、消去してよし
Dim Cel As Range
'初期値設定
'保存範囲のアドレス情報修正（CON一行目）
With WshDSTN
For Each Cel In .Range("A1:BZ1") '頭にcon
Cel.Value = "con" & Cel.Value
Next Cel
（謙児） 2018/04/22(日) 18:46
済みませーん。以下のプログラムと代えてください。
※全部のプログラムを貼り付けてからじゃないと、 元のプログラムでは「初期値設定」が見当たらない、 と言うトラブルになります。
Sub タイトルとアドレス修正および名前定義追加() '一回実行すれば、消去してよし
Dim Cel As Range
'初期値設定
'保存範囲のアドレス情報修正（CON一行目）
With Sheets("保存")
For Each Cel In .Range("A1:BZ1") '頭にcon
Cel.Value = "con" & Cel.Value
Next Cel
'追加アドレス書き足し
.Range("CA1").Value = "納品書AE6"
.Range("CB1").Value = "納品書AG6"
.Range("CC1").Value = "納品書AI6"
.Range("CD1").Value = "請求書AE6"
.Range("CE1").Value = "請求書AG6"
.Range("CF1").Value = "請求書AI6"
.Range("CG1").Value = "請求書E16"
.Range("CA2").Value = "納品日"
.Range("CD2").Value = "請求日"
.Range("CG2").Value = "月分"
End With
'アドレス情報修正（ダイジェスト一行目）
With Sheets("ダイジェスト")
.Range("K1").Value = "納品書発行日付"
.Range("L1").Value = "請求書発行日付"
.Range("M1").Value = "請求書月分"
End With
'名前定義追加
With Sheets("con")
.Range("O5,P6,R6,T6,B7,B8,B10,P8,O10,E19,F20,H20,J20,F21,H21,J21,S4").Name = "必須データ"
.Range("P6,R6,T6,F20,H20,J20,F21,H21,J21,B27:B44,N27:O44,B46:B49,S4").Name = "明細"
'メニュー、一部表現を修正
.Range("V9").Value = "呼出(同名で一つ過去)"
.Range("V10").Value = "呼出(同名で一つあと)"
End With
Sheets("納品書").Range("AE6,AG6,AI6").Name = "納品書日付"
Sheets("請求書").Range("AE6,AG6,AI6,E16").Name = "請求書日付月分"
End Sub
（半平太） 2018/04/22(日) 19:16
１、３−２（ア）共通モジュールと３−２（イ）事前チェックモジュール と「ｃｏｎ」シートモジュール
は、１回限りと同じようにコードの実行をしなくてよろしいですよね。
シート名：納品書と請求書に作りましたボタンのみ保存の時に実行すればいいのですね。
当然、納品書と請求書の印刷後に保存ですね。（あわてて印刷前に保存しないように
使用者に伝えておかないといけませんね。）
上記１を確認してから下記の質問を確認するつもりでしたが、
先に、ここで一緒に質問させて頂きます。
例えば、請求書シートで発行日付（ｘｘ月も）を入れ保存した後、その請求書を再度呼び出すときに、
一致する照会番号をｃｏｎシートで呼出したら、ｃｏｎシートのどこかに請求書発行日付とｘｘ月が
表示され請求書のシートを見た時に同じ照会番号のデータの中に請求書発行日とｘｘ月が入ったデータを
見ることが出来るという事ですね。
（謙児） 2018/04/22(日) 20:24
＞１、３−２（ア）共通モジュールと３−２（イ）事前チェックモジュール と「ｃｏｎ」シートモジュール ＞ は、１回限りと同じようにコードの実行をしなくてよろしいですよね。
それは、業務中に自動的に実行されるプログラムなので、手操作で実行しないでください。
＞ シート名：納品書と請求書に作りましたボタンのみ保存の時に実行すればいいのですね。 ＞ 当然、納品書と請求書の印刷後に保存ですね。（あわてて印刷前に保存しないように ＞ 使用者に伝えておかないといけませんね。）
保存は、印刷する前でも、後でも構いません。 兎に角、一回は保存しないと、次回呼び出した時に、さっき入力した請求書の発行日とか「x」月分の再現できなくなります。
＞例えば、請求書シートで発行日付（ｘｘ月も）を入れ保存した後、その請求書を再度呼び出すときに、 ＞一致する照会番号をｃｏｎシートで呼出したら、ｃｏｎシートのどこかに請求書発行日付とｘｘ月が表示され ＞請求書のシートを見た時に同じ照会番号のデータの中に請求書発行日とｘｘ月が入ったデータを見ることが出来るという事ですね。
なんかちょっと違います。
conにはどこにも表れないですよ？（請求書シートに自動的に戻されるだけですけど？）
conに表したいなら、初めからconの方にそういうエリアを設けて手入力し、 請求書からそのセルを数式で参照させればいいハズです。（=con!セル番地）
その方が保存関連のプログラムは作りが簡単だったのですが、 謙児さんがそのやり方を選択をしなかった(請求書シートに手入力するとした）のですから、 conには請求書日付は表そうとは思わない、と言うのがご希望だと思ったのですがねぇ。。。
もうこれは変えられませんので、conで見たい場合は、 逆に、conの方から数式で請求書シートのセルを参照しに行くしかないです。
（半平太） 2018/04/22(日) 21:04
保存ボタンは、見積書シートにもいるんじゃないかなぁなんて思い始めているんですが・・
（現在、見積書シートでは、保存ボタンは作動しません。）
必要なら、conシートモジュール内にある以下のプログラムを変更してください。
Public Sub storeFromDLVRorPAY()
Dim CAN As Boolean
If ActiveSheet.Name = "納品書" Or ActiveSheet.Name = "請求書" Or ActiveSheet.Name = "見積書" Then
Call Worksheet_BeforeRightClick(Sheets("con").Range("V12"), CAN) ’↑
End If ' │
End Sub ' │
’│
’見積書を追加ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー┘
（半平太） 2018/04/22(日) 21:13
＞ 保存は、印刷する前でも、後でも構いません。
済みません。説明するのを忘れていました。
保存しても、データはクリアしないように変更しました。
※どうも、クリアすると使い勝手が悪くなるような気がしたので。 その一方で、前の取引データを残しておくのは、 こんどは消し忘れで事務ミスを誘発しないか不安が生じるんですけど・・両方はカバーできないです。
（半平太） 2018/04/22(日) 21:34
まず２１：３４のコメント、理解しました。有難うございます。
＞ 保存は、印刷する前でも、後でも構いません。
はい、
＞ 済みません。説明するのを忘れていました。
どういたしまして。
＞保存しても、データはクリアしないように変更しました。
ありがとうございます。
＞こんどは消し忘れで事務ミスを誘発しないか不安が生じるんですけど・・両方はカバーできないです。
当方で間違いしないように策を取り入れます。
以下は、先程かち合った私のコメントです。
半平太さん
＞それは、業務中に自動的に実行されるプログラムなので、手操作で実行しないでください。
わかりました。
＞兎に角、一回は保存しないと、次回呼び出した時に、さっき入力した請求書の発行日とか「x」月分の再現＞できなくなります。
はい、わかりました。
＞conにはどこにも表れないですよ？（請求書シートに自動的に戻されるだけですけど？）
私の思いは、請求書に自動的に戻されたらそれで了承なのです。
言い方は悪かったですが、conに表さないと請求書シートに転記されないと思っていましたので。
＞請求書シートに自動的に戻されるだけですけど
であれば、是非にもconに入れようという気持ちはありませんので。
＞その方が保存関連のプログラムは作りが簡単だったのですが、
その方が、簡単だったのですね、知らぬこととはいえ申し訳ありませんでした。
＞謙児さんがそのやり方を選択をしなかった(請求書シートに手入力するとした）のですから、
＞conには請求書日付は表そうとは思わない、と言うのがご希望だと思ったのですがねぇ。。。
言い訳はよくないのですが、conで入力した発行日付は、見積書・納品書・請求書の発行日付に
転記されると思い、納品書もしくは請求書のみ違う日付は、納品書・請求書のところでないと、
違う日付に出来ないと勝手に思い込んでいたからです。
理解不足でご迷惑ばかり（余計な時間をとり）かけてすみませんでした。
これから色々データを入れて見ていきます。
（謙児） 2018/04/22(日) 21:49
（半平太） 2018/04/22(日) 21:13のコメントを逃がしていました。前回もありましたので、注意していき
ます。
＞保存ボタンは、見積書シートにもいるんじゃないかなぁなんて思い始めているんですが・・
＞If ActiveSheet.Name = "納品書" Or ActiveSheet.Name = "請求書" Or ActiveSheet.Name = "見積書"
見積書を記載してボタンをつくり確認をしました。有難うございます。
しかしconのデータを作って＝con により見積書に反映され conで保存しますので、そこに慣れているのに
見積書で保存となれば使う人は、紛らわしいように思うのですが、見積書シートにもいるんじゃないかな
ぁなんて と言われるのは、どんな時に必要になってくるのでしょうか？
下記は、納品書と請求書の日付等の追加によるお返事です。
今、各呼出等（新規、保存も含めて）を２回ほど繰り返し実行しました。
新規も３つの項目を選び確認をしました。選択表示の枠に感動しました。
納品書、請求書の発行日、（ｘｘ月分）も入力した結果（保存ボタンをクリックして）、保存のシートにも
当然ですが、各発行日が表示されていました。
今のところすべてがうまく行っています。これで大丈夫ですと完了したあとで、万が一 実際に使用して
いる時にうまく行かなかったからと再度、質問するのはよくないと思いますので、明日、会社に行ってから
合間を見て、再度色々試して行きます。
お返事いたしますので、お待ちください。
有難うございます。お疲れ様です。
今、各呼出等（新規、保存も含めて）を２回ほど繰り返し実行しました。
新規も３つの項目を選び確認をしました。選択表示の枠に感動しました。
納品書、請求書の発行日、（ｘｘ月分）も入力した結果（保存ボタンをクリックして）、保存のシートにも当然ですが、各発行日が表示されていました。
今のところすべてがうまく行っています。これで大丈夫ですが、
明日、会社に行ってから再度色々試して行きます。
また連絡します。
沢山のコードを作成していただき、このように満たされたものが出来ましたが
（謙児） 2018/04/22(日) 23:33
＞しかしconのデータを作って＝con により見積書に反映され conで保存しますので、そこに慣れているのに ＞見積書で保存となれば使う人は、紛らわしいように思うのですが、
慣れている方法がconから保存なら、確かに紛らわしいですね。
＞見積書シートにもいるんじゃないかなぁなんて と言われるのは、どんな時に必要になってくるのでしょうか？
納品書も請求書も保存はボタンでやるのに、見積書だけ同じように出来なかったら 一貫性がなくて戸惑うのではないか・・・と言うのが実務を知らない私の推測でした。
見積書には不要であれば、私のたわごとは無視してください。
＞お返事いたしますので、お待ちください。
焦らなくていいです。 ２週間くらいかけてください。それまで音信不通で構いません。
ただし、1ヶ月経つと、当方忘却モードに入りますので、 その後、どう対応できるかは保証の限りではありません。
（半平太） 2018/04/22(日) 23:52
〉1ヶ月経つと、当方忘却モードに入りますので、
表現が面白くて笑いました。
2週間迄に連絡します。
（謙治） 2018/04/23(月) 00:16
お返事がやっとできるようになりました。
他の方たちに使って頂き、喜んで頂けたことが一番うれしいです。
それも半平太さんのおかげです。
最後の質問ですが、２点ですが、
１、サブリストは、照会番号を変更しても前のデータから変わらない時がありますが、どいう出方をしていま
したか？ 気になるところでは、ないのですが 後々に質問するのは愚問かと思いました。
一度聞いたことがあるのですが、今までの質疑応答を見ましたがたくさんあって目が悪く
見つけるのが困難でした。すみません。
２、もし今後、他の表（項目名が違っていたり項目の範囲が違う場合）を作成することがある場合に、
保存して再度呼び込んで変更するしたい場合、今のＶＢＡのコードで必要なものはどれですか？
（こちらから範囲をお伝えした後で、ＶＢＡを１回実行といわれたようなことがありましたが。
そういうコードとか、保存の一行目の範囲は、新しい表の場合に私が項目名にそって範囲を記載して
良いものなのでしょうか？）
以上です。
（謙治） 2018/05/06(日) 22:01
＞１、サブリストは、照会番号を変更しても前のデータから変わらない時がありますが、どいう出方をしていま ＞ したか？
以下の３セルが右クリックされる都度、C列のリストを瞬時に作り直して、「最後尾、現在より前、後」を判断させるのに使っています。
呼出(取引先名で) 呼出(一つ過去) 呼出(一つあと)
＞２、もし今後、他の表（項目名が違っていたり項目の範囲が違う場合）を作成することがある場合に ＞ 保存して再度呼び込んで変更するしたい場合、今のＶＢＡのコードで必要なものはどれですか？
項目名はメモと同じで、どんな変更をしてもプログラムには無影響です。
項目の範囲は変更すると保存する順番(列番）に影響するので、軽々しく出来ません。
※保存シートの1行目に書かれているアドレス情報と符合しない場所にデータが書き込まれることになり、 呼出すと、対応関係にないデータが1行目で指定されたアドレスのセルに書き込まれて行きます。
＞こちらから範囲をお伝えした後で、ＶＢＡを１回実行といわれたようなことがありましたが。 ＞そういうコードとか、保存の一行目の範囲は、新しい表の場合に私が項目名にそって範囲を記載して ＞良いものなのでしょうか？）
項目名は見に行かないので、プログラム処理上なんの作用も及ぼしません。
「レイアウトは変更しない」と言う前提で作っていますので、今から柔軟に対応できる様に変更するのは無理です。 (私の仕事ならやりますけども、単なる暇つぶしですからねぇ）
メンテのスキルを上げたい、別プロジェクトを作りたい、と言うことであれば、 先ずは、簡単なサンプルで練習を積んでください。
以前、挙げたサンプルを流用してやりましょう。
見積書シート
行 ___A___ ____B____ ____C____ ____D____ _____E_____
1 患者名 仮病月男
2 入院日 2018/4/17
3 病名 虚言癖
4 検査済み うそ発見器
5 寿命 あと少し
保存シート(1件目保存後）
行 ____A____ ___B___ ___C___ _____D_____ ____E____
1
2 患者名 入院日 病名 検査済み 寿命
3 仮病月男 2018/4/17 虚言癖 うそ発見器 あと少し
１．保存シートの1行目にはどんなアドレスが入ればいいと考えますか？ ２．そのアドレスを自動的に書き込むには、どんなプログラムを作ればいいか分かりますか？
（半平太） 2018/05/07(月) 00:23
遅くなって申し訳ございませんでした。
＞ 2018/05/07(月) 00:23
この時間は、私の一番尊敬する人の亡くなった時間です。
驚きました。
＞以下の３セルが右クリックされる都度、C列のリストを瞬時に作り直して、「最後尾、現在より前、後」を 判断させるのに使っています。
わかりました。有難うございます。
＞「レイアウトは変更しない」と言う前提で作っていますので、今から柔軟に対応できる様に変更するのは
無理です。
(私の仕事ならやりますけども、単なる暇つぶしですからねぇ）
他の表を作るうえで、今回のシート（ＶＢＡを使用して）の活用は難しいことが、わかりました、
ひょっとすると今後も仕事で、保存したものを再度呼び込んで変更、上書き保存をしないと
思いますので諦めます。
＞１．保存シートの1行目にはどんなアドレスが入ればいいと考えますか？
b1,c2,c3,e4,c5 と思います。
＞２．そのアドレスを自動的に書き込むには、どんなプログラムを作ればいいか分かりますか？
Ａ列からＢＣＤと右横列にデータの並び順にもってくるという事でしょうか？
（謙治） 2018/05/07(月) 15:52
＞諦めます。
何かを諦めたんしょうが、多分練習もする必要がなくなったのだと思いますので、 これで本件終息にします。
（半平太） 2018/05/07(月) 17:02
＞何かを諦めたんしょうが
私の能力がないばかりに、本当にたくさんの時間を半平太さんに費やして頂きました。
申し訳ない限りと思っています。
ここに来て自動処理のデータが完成しました。社員も喜んでいます。
ここまでくる迄に、途中で早く半平太さんに終わって休んで頂きたいと思っていても
へまをしてばかりの私ですから、思うような結果が出ない為、質問をしつづけてご迷惑ばかり
かけていました。
ですから、本件が完成したことによって、今後違うフォームのデータを作成する場合にも、
新規データ保存、呼出、上書き保存等のＶＢＡでのやり方を教えてもらっていたら 今後役立つし
そちらに質問してまた沢山の時間をかけご迷惑をかけないで済むと思ってＶＢＡを教えて下さいと
聞きました。（データ変更が難かしいことは、上記で理解でいました。）
そんな中、
＞メンテのスキルを上げたい、別プロジェクトを作りたい、と言うことであれば、
＞ 先ずは、簡単なサンプルで練習を積んでください。
と以前の例を出して教えて頂こうとされました。
そうなるとまた私が途中でわからなくなると質問をします。半平太さんが色々例題を出され
コメント下さる、次に私がわからないから再度質問をします。それを繰り返すような気がしたので、
もうこれ以上ご迷惑をかけたくなかったので、ＶＢＡの保存を、諦めるといいました。
本当に長時間、顔も見えない私に一生懸命になって頂き、諦めないで教えて下さり感謝しています。
本当に有難うございました。
この場をお借りして この件で最初にお世話になりました、半平太さんと同じほど一生懸命に
諦めづに教えて頂いたSoulManさん（教えて頂いた複数行のデータの保存の度、一行づつ空けての保存。
結果、皆様がコメントされた１行づつのデータ管理（呼び出しも出来る為）を選択しましたが‐‐‐大変
申し訳なく思っています。）に感謝です。有難うございました。
そして色々コメントしていただいた、隠居じーさん、もこな２さん、まっつわん さん も有難うございました。ご親切、忘れは致しません。嬉しい限りです。
皆様、ご自愛ください。
、
（、 そして色々隠居じーさん） 2018/04/01(日) 00:13
（もこな２） 2018/04/01(日) 11:53
（まっつわん
（謙児） 2018/05/07(月) 22:31
いやー、「練習」に関しては、謙児さんに考え、書いて頂く積りでした。
なので、いくら延びても、私が汗をかくような展開にはならなかったです。 まぁ、サンプルはデータも単純なので、当方は何とでも対処できますけどね。
実務システムは、扱うデータも複雑ですし、事務ミス防止や使い勝手なんかにも 配慮しないとならないですから、初学者が作れるようなもんじゃないです。
練習については、別トピを立ててやったらどうですか？ 色んな人のアイデアが聞けると思います。（私は参加しないですが）
いずれにしても、自分の手と頭を使う覚悟でやってください。
（半平太） 2018/05/07(月) 23:43
半平太さん
おはようございます。
＞なので、いくら延びても、私が汗をかくような展開にはならなかったです。
そうでしたか。
＞扱うデータも複雑ですし、事務ミス防止や使い勝手なんかにも
＞配慮しないとならないですから、初学者が作れるようなもんじゃないです。
はい、
＞いずれにしても、自分の手と頭を使う覚悟でやってください。
はい。
再度、有難うございました。
（謙児） 2018/05/08(火) 07:46
今のところ、平成が３１年５月１日に変わるため、conシートの日付欄の年号を西暦にしようと試しました。
例えば、年の箇所が、２０１８年 と入れますと シート”保存”は、2018になりますが、
ダイジェストは、4006となります。
ダイジェストで2018に変更は、出来ませんか？
（謙児） 2018/05/10(木) 18:06
見積書シートのO6セル(オー6) は、これまで「平成」だったと思うんですが、 今どうなっているんですか？ (「西暦」？、何もなし？）
新元号が決まった後は、どうするんですか？ 引続き西暦(または何もなし？） それとも、元号方式に戻すんですか？
（半平太） 2018/05/10(木) 19:34
＞今どうなっているんですか？ (「西暦」？、何もなし？）
今は、平成です。
２・３日後に、社員に対して、”con”のファイルを配信するのですが、
今までは、よく使う人と他二人の人にテスト的使って頂き了承して頂きました。
それでマニュアルとか説明文をまとめなおして、メニューの例題をつくり順番に
試してもらうように作成しているところで、ふっと思ったのです。
平成が変わるときに元号を変えたなら、日付をコントロールの書式設定で最小値を１にして
最大値を５０くらいにすればいいと思ったのですが、現在、日付を、平成ｘｘ年と入れても
ダイジェストシートには、西暦に変わっていますので 来年元号が変わる時点で新しい
元号をダイジェストの西暦に変えるＶＢＡがわからないので、（その時に質問出来ませんし）
それだったら初めから西暦にしようと思ったのです。
新元号が決まった時点でダイジェストが西暦になる方法を今の時点で出来るのであれば、
新元号で行きたいです。
よろしくお願いします。
（謙児） 2018/05/10(木) 20:25
＞今は、平成です
そこに2018年と入れれば、平成2018年ですから西暦4006年に当たりますね。
引続き和暦で入れればいいんじゃないですか？
ダイジェストに関しては、自然体で新旧元号に対応すると思います。(Microsoft社の対応待ちです）
問題は、conの方になると思います。 データは年数しか覚えていないですから、それが平成なのか、新元号なのか区別がつきません。
O6(オー6)セルも保存対象にする様に変更するしかないと思います。
（半平太） 2018/05/10(木) 21:00
ちょっと待ってくださいよぉー？
今後は、西暦一本でやる選択肢があるなら、そっちの方が修正は簡単なので、有り難いです。
ダイジェストの年表示を変えるだけで済みますので。
（半平太） 2018/05/10(木) 21:08
ふと思ったのですが、改めてですが、conの平成ｘｘ年 が保存でもｘｘとなりますが、
ダイジェストでは、西暦になっています。ダイジェストが、保存と同じように平成のｘｘに表示
されないのでしょうか？
ダイジェストが西暦になっているのは、何かをしている為に西暦になっているのでしょうか？
（謙児） 2018/05/11(金) 09:14
ダイジェストの日付は、データ(シリアル値）に換算できるものは、換算後のデータにしています。 それを単純結合の文字列に変更することは簡単です。
ダイジェストの日付は、呼出に関係しないので何とでもできます。
問題はconの方で、呼出すと、単に「××」ですから、 その左の元号が保存した時と違っていたら、ナンセンスな日付になります。
（半平太） 2018/05/11(金) 09:55
＞その左の元号が保存した時と違っていたら、ナンセンスな日付になります。
その左の元号が保存した時と違っていたらーーの意味は、conの日付と保存時の
ダイジェストの日付を言っているのでしょうか？
＞引続き和暦で入れればいいんじゃないですか？
＞ダイジェストに関しては、自然体で新旧元号に対応すると思います。(Microsoft社の対応待ちです）
＞問題は、conの方になると思います。
＞データは年数しか覚えていないですから、それが平成なのか、新元号なのか区別がつきません。
上記を読んで、当初の私の質問内容と違うことになるかもしれませんが、下記のようにしていただければ
いいのかなあと思いました。
結論：
１、＞引続き和暦で入れればいいんじゃないですか？
和暦で行こうと思っています。
（conシートの日付で、平成の文字は、保存しません。その代わり保存シートのＢ２行目に発行平成年
と入れて、その列の元号であると読み取れば大丈夫では、ありませんか？）
２、ダイジェストシートは、
＞ダイジェストに関しては、自然体で新旧元号に対応すると思います。(Microsoft社の対応待ちです）
対応するのであれば、（私は、安心しました。）そのまま西暦にして頂きます。
以上です。まとめが下手で申し訳ございません。
（謙児） 2018/05/11(金) 12:28
（謙児） 2018/05/11(金) 12:28 の案件であれば、半平太さんに
手を煩わせなくてもいいと思ったからです。
（謙児） 2018/05/11(金) 13:56
＞＞その左の元号が保存した時と違っていたら、ナンセンスな日付になります。 ＞その左の元号が保存した時と違っていたらーーの意味は、conの日付と保存時の ＞ダイジェストの日付を言っているのでしょうか？
いえ、ダイジェストは最新状態だけ保存・上書して行けばいいので、 何も心配いらないです。
conは、新元号に変わった後、平成のデータを呼び出すと 新元号+平成年数の組合せになるのでナンセンスな日付になります。
＞（conシートの日付で、平成の文字は、保存しません。その代わり保存シートのＢ２行目に発行平成年 ＞ と入れて、その列の元号であると読み取れば大丈夫では、ありませんか？）
各行のデータは別々の元号ですから、2行目だけで全取引をまかなうことは出来ないです。
ただ、年数が20年以下なら新元号と見做す、それより大きければ平成、と言う決め打ち対応はできます。 それで、このシステムを20年間、持たせることはできます。
（半平太） 2018/05/11(金) 13:59
上文で、やっと理解出来ました。 〉各行のデータは別々の元号ですから、2行目だけで全取引をまかなうことは出来ないです。 ここも、理解出来ました。
〉ただ、年数が20年以下なら新元号と見做す、それより大きければ平成、と言う決め打ち対応はできます。
是非その案でお願いします。
（謙児） 2018/05/11(金) 14:19
簡略に対応するため、元号は、数式で出すようにします。
※使う人には、元号を手で入れない様に指導してください。（さもないと数式が壊れます）
※正式決定より早く、新元号入りの見積有効期限を使う必要性が生じた場合、
正式にどうするのか分かりませんが、多分、書きようがないので
平成の延長になるんでしょうが、気の早い人は1年を入れるかも知れないですね。
その時は "新元号" 字句のマンマになります。ご留意を。
１．準備
「元号」と言う名前の定義を行います。
Ctrlキーを押しながら、F3キーを押下すると名前定義ダイアログが出ますので、 「新規作成」ボタンをクリックし、下記設定をしてください。
名前 → 元号 参照範囲ボックス → ="新元号" │ │正式に決まり次第、同じ要領で修正編集を行ってください。 ↓ ※ 参照範囲ボックス → ="決定元号"
２．埋め込む数式
<con>シート O6セル =IF(P6="",TEXT(TODAY(),"ggg"),IF(P6<=20,元号,"平成")) E20セル =IF(F20="",TEXT(TODAY(),"ggg"),IF(F20<=20,元号,"平成")) E21セル =IF(F21="",TEXT(TODAY(),"ggg"),IF(F21<=20,元号,"平成"))
<納品書>シート AD6セル =IF(AE6="",TEXT(TODAY(),"ggg"),IF(AE6<=20,元号,"平成"))
<請求書>シート AD6セル =IF(AE6="",TEXT(TODAY(),"ggg"),IF(AE6<=20,元号,"平成"))
３．何年かして、平成のデータが過去分としても必要なくなったら、 上記数式を「決定元号」の生データ値に変えてください。
４．1年目は「元」年表記ですので、年数が入るセルには「セルの書式（表示形式）」の ユーザー定義で、以下の様に設定してください。（見かけのみ「元」とします。実体は１のままです）
[=1]"元";G/標準
５．少しプログラムを変更します。
conシートモジュール内の以下のマクロを差し替えてください。
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
If IsEmpty(DateRemade) And Left(str, 3) = "新元号" Then
DateRemade = str
End If
End Function
（半平太） 2018/05/11(金) 17:21
＞５．少しプログラムを変更します。
下記を上記５のコードに変えればいいのですね。(私が間違ってはいけないための確認です。）
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)
If Err.Number <> 0 Then
DateRemade = str
End If
On Error GoTo 0
End Function
（謙児） 2018/05/11(金) 18:05
＞下記を上記５のコードに変えればいいのですね。(私が間違ってはいけないための確認です。
そうです。そのFunctionを丸ごと差し替えです。
（半平太） 2018/05/11(金) 18:10
＞そうです。そのFunctionを丸ごと差し替えです。
今、差し替えました。
これでコード等、今することは、終わりですよね。
あとは、元年が定まれば※ 参照範囲ボックス → ="決定元号"に編集するだけで良いのですね。
（謙児） 2018/05/11(金) 18:34
＞あとは、元年が定まれば※ 参照範囲ボックス → ="決定元号"に編集するだけで良いのですね。
はいそうです。 そのまんま「"決定元号"」なんて文字を入れないでくださいね。
あと、「元」年表示になるセルに、文字の「元」を入れない様に指導してください。 あくまで、実体の「１」を入力してください。
（半平太） 2018/05/11(金) 19:41
では、改めて色々有難うございました。
ご自愛ください。
（謙児） 2018/05/11(金) 19:47
＞正式に決まり次第、同じ要領で修正編集を行ってください。
正式に決まってから編集をして万が一誤っては、先へ進まないと思い、
今、参照範囲ボックス →元号を融和”に編集して実験をしました。
＞あくまで、実体の「１」を入力してください。
conシートのＰ６に１を入れましたら同シートＯ６の平成の文字のところが”融和”に変わりました。
感激しました。これで正式に号が決まっても編集できます。
社員にこのファイルを添付するときには、元号を変更するときと題して、半平太さんから教えて頂いた
事を記載をしておきます。
一つお願いですが、下記のメニュー画面で呼出等右クリックしたときに背景に黄色が出るのですが、
無色にして頂きたいのです。（周りにメリハリをつけるために背景を色分けしましたので
かえって見にくくなるのです。私が悪いのですが）
但し、現状の呼出等につくピンクっぽい色は、他を無色にかえた時にわかりやすいので、そのまま
残して頂けますか。
呼出 ?A 番号/名前
新 規（新規照会番号を?Aに入力後?@を右クリック）
照会番号を?Aに入力後、?@を右クリックで呼出
納品先名を?Aに入力後 ?@を右クリックで呼出 3
現表示と同納品先名の一つ過去を表示、?@を右クリックで呼出 入力不要
現表示と同納品先名の一つあとを表示、 ?@を右クリックで呼出 入力不要
直前に保存した分の表示、?@を右クリックで呼出 3
保 存 （現表示） ?@を右クリック 入力不要
（謙児） 2018/05/12(土) 14:07
conシートモジュール内の以下のプログラムを 65535からxlNone に変更してください。（一か所）
Private Sub coloring(first As Long, second As Long, third As Long)
Application.ScreenUpdating = False
With Range("V6:V12")
.Cells.Interior.Color = xlNone ' 65535 ← ここ
（半平太） 2018/05/12(土) 16:47
65535→カラー番号ですね。 カラー番号を xlNone に置き換えることで無色になるのですね。
ちなみに現時点での呼込みの色（ピンクっぽい色）が出るのは、
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
このコードによって色が右クリックするたびに出るのですね。
（謙児） 2018/05/12(土) 18:54
＞このコードによって色が右クリックするたびに出るのですね。
はい、そうです。
実際には、firstしか使ってなかったと記憶します。
当初は、メニュー各セルの色分けを３色使って、色んなパターンでやろうかなと思って 作ったサブルーチンです。
（半平太） 2018/05/12(土) 20:15
＞今、参照範囲ボックス →元号を融和”に編集して実験をしました。
それを見て、 年数が「1」なら2019年5月1以降と判断して、処理すればいいと思い始めました。
そう考えれば、マイクロソフト社の対応を待たずして 「新元号」だろうが「融和」だろうが、ダイジェスト用の西暦換算は出来ます。
もうちょっと考えてみます。
（半平太） 2018/05/12(土) 21:31
年数で新旧元号の時代を判断して、ダイジェストの日付を西暦換算する方針にしました。 (マイクロソフトの対応に関係なく処理できます）
conシートモジュール内の DateRemade を以下のコードで丸ごと差し替えください。
Function DateRemade(ByRef rSource As Range)
Dim mayGoAhead As Boolean
On Error Resume Next
mayGoAhead = IsDate(DateSerial(rSource(1, 2), rSource(1, 4), rSource(1, 6)))
On Error GoTo 0
If mayGoAhead Then '日付化可能のケース
If Date < DateSerial(2039, 1, 1) Then ’改元後20年間の処置
Select Case rSource(1, 2) '年数で分岐
Case 1 To 20 '改元後
DateRemade = DateSerial(rSource(1, 2) + 2018, rSource(1, 4), rSource(1, 6))
Case Is > 20 '平成
DateRemade = DateSerial(rSource(1, 2) + 1988, rSource(1, 4), rSource(1, 6))
Case Else
'何もせず、Emptyを返す
End Select
Else '改元後20年間が経過した後(改元後の御代が続いていれば)
DateRemade = DateSerial(rSource(1, 2) + 2018, rSource(1, 4), rSource(1, 6))
End If
End If
End Function
（半平太） 2018/05/12(土) 23:29
別件で、気づくのが遅く申し訳ないのですが、
メニュー画面で新規を右クリックすると「クリアするデータ範囲を番号で指定してください」と
３つのコメントが出ますが、最初の１、全クリア（純粋新規）をクリックしたときに、
conシートのデータ入力箇所で、Ｐ8（担当者名）とＯ１０(EーＭａｉｌ）とＯ１３（担当部署名）は、
消えないようにして頂けないでしょうか？
（このファイルを配信すれば、各自のデータになりますから、各自のデータは消さない方が
いいと思いまして）
（謙児） 2018/05/13(日) 13:44
メニュ-の新規に照会番号を入れて右クリックしたときに進捗が見積書迄と入れていたのに、
１に変わります。なぜ１に変わるのでしたか？
支障がなければ、進捗に文字等を入れた後で新規を右クリックしたときに１に変わらないように
お願いします。
（謙児） 2018/05/13(日) 14:24
＞最初の１、全クリア（純粋新規）をクリックしたときに、 ＞conシートのデータ入力箇所で、Ｐ8（担当者名）とＯ１０(EーＭａｉｌ）とＯ１３（担当部署名）は、 ＞消えないようにして頂けないでしょうか？
クリア用に設定した名前定義を変更すれば出来ます。(後述の問題と絡んできますけど)
＞メニュ-の新規に照会番号を入れて右クリックしたときに進捗が見積書迄と入れていたのに、 ＞１に変わります。なぜ１に変わるのでしたか？
進捗度は、「1〜3(請求書迄)」または「1〜4(代金領収済)」を想定していました。
どう使うかはそちらの自由ですが、まさか漢字を入れるとは思っていませんでした。
＞支障がなければ、進捗に文字等を入れた後で新規を右クリックしたときに１に変わらないように
「進捗に文字等を入れた後」と言っても、新規の為にわざわざ入れたのか、 その顧客の過去データ(例えば請求書段階）を呼出して、「請求書迄」となっている状態のが入っているだけのか 分からないと思うんですけど、大丈夫なんですか？
後者の状態だったら、新規なのに進捗度が「請求書迄」が居座る事になるんじゃないですか？
全員が新規には「見積書迄」とする会社ルールなら、「1」の代わりに「見積書迄」を入れる様に変更すればいいですが、 担当者毎に進捗度の表現が違うとしたら、厄介な話だなぁと言う気がしますけども。
（半平太） 2018/05/13(日) 15:55
進捗度は、「1〜3(請求書迄)」または「1〜4(代金領収済)」を想定していました。 そうでしたか。わかりました。
数字に意味を持たせて数字１〜４を入れる、この方がいいですね。
現状では、メニューの新規を右クリックすれば照会番号が１と出ます。
その１を保存して再度呼出した時には、進捗度は、１のままです。（テスト済みです。）
２から４に変えるのは、どこで変えるのですか？
もしかしたらシート保存の右端のＢＺの進捗度欄で変えるのですか？
＞進捗に文字等を入れた後」と言っても、新規の為にわざわざ入れたのか、
＞その顧客の過去データ(例えば請求書段階）を呼出して、「請求書迄」となっている状態のが入っている
＞だけのか 分からないと思うんですけど、大丈夫なんですか？
＞後者の状態だったら、新規なのに進捗度が「請求書迄」が居座る事になるんじゃないですか？
メニューの新規で進捗度に文字を入れるのは、新規の時に新しい照会番号を入れて
右クリックするときだけです。
＞その顧客の過去データ(例えば請求書段階）を呼出して、「請求書迄」となっている状態は、
呼出すのですから、新規ではないといえますよね。
呼び出した結果、進捗度の表示が「請求書迄」は、もともと請求書迄で保存しているのですから
良いのではないでしょうか？
もしそこで現実に請求書発送が終わり入金となった場合には、進捗度欄に４（代金領収済み）を
入れてもいいと思うのですが？
私が、理解不足で、間違っていることを言っているかもしれませんが、よろしくお願いします。
（謙児） 2018/05/13(日) 16:53
＞進捗度は、「1〜3(請求書迄)」または「1〜4(代金領収済)」を想定していました。 そうでしたか。わかりました。 ＞数字に意味を持たせて数字１〜４を入れる、この方がいいですね。
数字でよければ、新規は「1」なので、現状維持でいいと思いますけど、 結論を聞かせてください。
文字なら、新規入力時、全員「見積書迄」とするのかどうか。
＞現状では、メニューの新規を右クリックすれば照会番号が１と出ます。 ＞その１を保存して再度呼出した時には、進捗度は、１のままです。（テスト済みです。） ＞２から４に変えるのは、どこで変えるのですか？
conシートのS4セルです。
通常は、新規で1にして保存 納品書を作る時、呼出すとそこはまだ1になっているので、手入力で2に変える 請求書を作る時、呼出すとそこはまだ2になっているので、手入力で3に変える 入金があったら、呼出すとそこはまだ3になっているので、手入力で4に変える
と言う流れを想定していますが。
＞メニューの新規で進捗度に文字を入れるのは、新規の時に新しい照会番号を入れて ＞右クリックするときだけです。 ＞その顧客の過去データ(例えば請求書段階）を呼出して、「請求書迄」となっている状態は、 ＞呼出すのですから、新規ではないといえますよね。
それは、謙児さんの想像だと思いますけども・・ 実務者は、できるだけ入力の手間を省きたいんです。
先ず、新規入力したい取引先の過去のデータを呼出します(もしあればです）。 そして、前回の取引条件等を頭に入れます。
次に新規取引データの入力段階に入ります。
もし、さっき呼出した情報(取引先名、住所、担当者名とか）がそのまま使える内容なら、 呼出した状態のまま、新規用の「照会番号」を入れて「新規」セルを右クリックするハズです。 なんたって、その方が楽ですから。
そして、エクセル側から、どこをクリアするかと訊かれると 2番を指定すると思います。 ↓ "2 = 日付・明細・進捗度のみクリア（顧客情報は残す）"
その時、呼出したのが「請求書迄」のデータだったら、それがS4セル居残っちゃいます。
私としては、新規なら、そこ(S4セル）は強制的に「1」とか「見積書迄」を入れた方がいいと考えます。
（半平太） 2018/05/13(日) 17:41
]通常は、新規で1にして保存 納品書を作る時、呼出すとそこはまだ1になっているので、手入力で2に変える
請求書を作る時、呼出すとそこはまだ2になっているので、手入力で3に変える 入金があったら、呼出すとそこはまだ3になっているので、手入力で4に変える
と言う流れを想定していますが。 理解しましたので、それでいきます。
＞（半平太さん） 2018/05/13(日) 17:41の上文を繰り返し読んでいる間に、
半平太さんが言っている事、ようやくわかりました。
私が、勘違いしていました。新規という言葉に惑わされ 新規は、ま新しい照会番号を入れて右クリックする
事に拘り進捗度を入れないといけないと思い込んでいました。
半平太さんがいっている、保存データを呼出し一部を変え新規で照会番号を入れて右クリックすることも
新規という事が眼中になかったです。
半平太さんが言われるように、保存データから呼出したのであれば、呼び出すときに進捗度が請求書になって
おれば呼出したデータを新規として照会番号を新しくしても進捗度”請求書”は言われるように残った
ままです。
理解不足で、時間をおかけしてすみませんでした。
では、保留となっています。
最初の１、全クリア（純粋新規）をクリックしたときに、
conシートのデータ入力箇所で、Ｐ8（担当者名）とＯ１０(EーＭａｉｌ）とＯ１３（担当部署名）は、
消えないようにして頂けないでしょうか？
よろしくお願いします。
（謙児） 2018/05/13(日) 19:45
１．簡略対応で、3つのセルの値を覚えて置き、今まで通りクリアした後に、元に戻すことにします。
conシートモジュール内の Worksheet_BeforeRightClick の中にある「新規処理」の部分にパッチを当てる(全７行挿入)
Loop Until goAhead
Dim store(1 To 3) '1 疎開
store(1) = Range("P8").Value '2
store(2) = Range("O10").Value '3
store(3) = Range("O13").Value '4
'指定範囲を先行クリアする
clearAreaByCase (Array(AreaAll, AreaDetails, AreaDateDELnPAY)(CLng(ans) - 1))
Range("P8").Value = store(1) '5 疎開から戻す
Range("O10").Value = store(2) '6
Range("O13").Value = store(3) '7
'照会番号と進捗度は1をセット
Range("S4").Value = 1
２．ちょっと気になったんですが、 保存の時「保存しました」と出ますが、保存シートに書いただけで、 エクセルのブック自体は保存されていません。
操作者が勘違いしないといいんですけどね。
(いっそのこと、ブック保存も同時にする仕掛けに変えた方がいいかも知れません)
（半平太） 2018/05/13(日) 22:35
＞操作者が勘違いしないといいんですけどね。 気づいて頂き有難うございます。 ＞ （いっそのこと、ブック保存も同時にする仕掛けに変えた方がいいかも知れません) そのようにお願いします。 メニューの保存は、右クリックするのを納品書・請求書と同じく コントロールボタンで出来ませんか？（面倒でしたらいいですよ） 納品書又は請求書の日付を入力後に保存した場合も、ブック保存されるということですね。
（謙児） 2018/05/13(日) 23:46
＞ そのようにお願いします。
conシートモジュール内の Worksheet_BeforeRightClick の中にある「保存処理」の部分にパッチを当てる(1行挿入) ※最終行(End Sub） から2行目です。
ーーー部分パッチーーーーーーーーーーーーー
coloring 7, 0, 0
ThisWorkbook.Save ’← 1行挿入
End Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーー
＞ メニューの保存は、右クリックするのを納品書・請求書と同じく ＞ コントロールボタンで出来ませんか？（面倒でしたらいいですよ）
conシートモジュール内の「storeFromDLVRorPAY」を以下のマクロに丸ごと変更してから、 コントロールボタンを追加してください。 （※2行削除することになるので、マクロはむしろ簡単になります。) （※他のシートのボタンに登録したマクロ名とは違っています。あっちは「StoreDataFromOtherThanCON」)
ーーーーー全面差し替えーーーーーーーーーーー
Public Sub storeFromDLVRorPAY()
Dim CAN As Boolean
Call Worksheet_BeforeRightClick(Sheets("con").Range("V12"), CAN)
End Sub
ーーーーーーーーーーーーーーーーーーーーーー
＞ 納品書又は請求書の日付を入力後に保存した場合も、ブック保存されるということですね。
はいそうです。
（半平太） 2018/05/14(月) 08:53
１．簡略対応で、3つのセルの値を覚えて置き、今まで通りクリアした後に、元に戻すことにします。
コードを追加しました。実行してうまく行きました。（言われるように一旦全部消えた後で表示されました。）
（半平太） 2018/05/14(月) 08:53付け
全て上手く行きました。コードの追加・入れ替えをしまして実行・確認をしましたら、
メニューの保存をすると同時にファイルの保存も出来ました。 そのボタンも出来てうまく走りました。
（新たにコードを入れる時に、コメントでわかりやすいように前後に残っているコードを記載して頂き
わかりやすかったです。今までもそのようにして頂いていましたが。）
重ね重ね有難うございました。
（謙児） 2018/05/14(月) 12:03
昨日、社員に配布する前に、再検討して例題を書き直している時に、
新規では、名前等が消えなかったので、他のことに気をつけていましたが、途中、えっと
思ったのが、メールアドレスのデータが変わっているのです。
conシートのＯ１０ メイルアドレスのデータkenjixx@.co.jp がrrrrに変わっているのです。
それで意識してみますと新規以外のメニューの呼出すべてがＯ１０のデータがrrrr（ｒが４つ）
に変わっているのです。？
下記の追加コードでよかったですよね。
store(2) = Range("O10").Value '3
メニューで新規の場合には、１から３迄は、
goAhead = InStr("-1-2-3-", "-" & ans & "-") > 0
Loop Until goAhead
Dim store(1 To 3) '1 疎開
store(1) = Range("P8").Value '2
store(2) = Range("O10").Value '3
store(3) = Range("O13").Value '4
'指定範囲を先行クリアする
clearAreaByCase (Array(AreaAll, AreaDetails, AreaDateDELnPAY)(CLng(ans) - 1))
Range("P8").Value = store(1) '5 疎開から戻す
Range("O10").Value = store(2) '6
Range("O13").Value = store(3) '7
'照会番号と進捗度は1をセット
Range("S4").Value = 1
preProcCell.Value = "新規"
（参考に値しないと思いますが、今思えば、４月２５日に保存したＣＯＮシートのメールアドレスの
データＯ１０のデータを仮に何かを入れて表示するつもりでキーボードでrrrrr（ｒを５つ）と
打ったことがあります。）
よろしくお願いいたします。
（謙児） 2018/05/15(火) 23:10
事情が呑み込めないです。
保存シートのK列のデータはどうなっていますか？
それが全てrrrrなら、呼出すとrrrrになるのは普通です。
一部、rrrrじゃないものがあれば、その照合番号をメモした後、 conシートから、その照合番号で呼び出して見てください。 その時、rrrrと出たら、おかしいと言えます。
次に、 保存シートのK列がrrrrとなっているものの中から一つ選んで、その照合番号をメモした後、 conシートから、その照合番号で呼び出して見てください。 その時、rrrrと出ると思いますが、それをkenjixx@.co.jpに変更して、保存とかなんかの処理をしてみてください。 その処理中に、急にrrrrと変われば、おかしいと言えます。
それ以外は、おかしいとは言いにくいです。
（半平太） 2018/05/15(火) 23:39
kenjixx@.co.jpで保存したことを覚えていたので、rrrrは、眼中になかったのです。
呼び出しで実行してkenjixx@.co.jpが出ると思ったのでrrrrが出た時に何故？とびっくりしました。
今、保存シートのＫ列を見ましたが、rrrrが残っていました。
その番号を呼出していました。当然rrrrになりますね。保存シートを先に見ればよかったのに
気が付かず情けないです。
申し訳ありませんでした。
（謙児） 2018/05/16(水) 00:01
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.