[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『仕入先の一覧に別ファイルから項目を追加したい』（みかん）
お世話になります。
今、手作業で加工しているエクセルを自動化してみようと思っています。
マクロ初心者なのですが、よろしくお願いします。
C列に仕入先コードが入っています。(何行あるかは決まっていません。)
B列に「*」が入っているデータだけ、別ファイルからデータを取得して、
Z列、AA列、AB列にデータをセットしたいです。
A列 B列 C列 〜〜〜 Z列 AA列 AB列
1 * 10001 aaaaa bbbbb ccccc
2 20001
3 30001
4 * 40001 jjjjj kkkkk lllll
5 * 50001 mmmmm nnnnn ooooo
: : : : : :
別ファイルに仕入先の情報が入っています。
A列 B列 C列 D列
10001 aaaaa bbbbb ccccc
20001 ddddd eeeee fffff 30001 ggggg hhhhh iiiii 40001 jjjjj kkkkk lllll 50001 mmmmm nnnnn ooooo : : : : : : : :
また、セットするZ列、AA列、AB列は、実行する時によって変わるので、
今回であれば、Z列と言う情報をマクロかエクセルのどこかに書いて、
Z列から横にデータを埋めて行くようにしたいです。
説明が上手くできていないかもしれないので、
わかりづらいところがあれば、書きなおしますので、
どうぞよろしくお願い致します。
マクロの骨格と言うか、ヒントだけでももらえたら嬉しいです。
＜ 使用 Excel：Excel2007、使用 OS：Windows7 ＞
マクロは「仕入先の一覧」ブックに書くんですか？
それとも、第3番目のブックに書くんですか？
（半平太） 2017/08/03(木) 21:02
ありがとうございます。
マクロは別のブックに書きたいです。
どうぞよろしくお願い致します。
（みかん） 2017/08/03(木) 21:08
(1)「仕入先一覧.xlsx」と「仕入先情報.xlsx]は処理対象シートがアクティブになっているものとします。
(2)マクロブックの<Sheet1>で、仮にH列を指定してみる。
マクロブックのSheet1のB1セルに「H」と入力する。(Z列からなら、「Z」と入れる)
行 ______A______ _B_ 1 書出し列番号 H ← ここ
------------------------------------------ 仕入先一覧ブックのアクティブシート（H列が指定されたので、H、I、J列に結果が表示される）
<一覧 結果図> 行 _A_ _B_ __C__ _D_ _E_ _F_ _G_ __H__ __I__ __J__ 1 1 * 10001 aaaaa bbbbb ccccc 2 2 20001 3 3 30001 4 4 * 40001 jjjjj kkkkk lllll 5 5 * 50001 mmmmm nnnnn ooooo
----------------------------------- 仕入先情報ブックのアクティブシート <情報 サンプル> 行 __A__ __B__ __C__ __D__ 1 10001 aaaaa bbbbb ccccc 2 20001 ddddd eeeee fffff 3 30001 ggggg hhhhh iiiii 4 40001 jjjjj kkkkk lllll 5 50001 mmmmm nnnnn ooooo
’標準モジュールに貼り付けるマクロ
’ ↓
Sub InfoUpdate()
Dim ws一覧 As Worksheet
Dim ws情報 As Worksheet
Dim rngSrc As Range
Dim rngInfo As Range
Dim cel As Range
Dim RW, AddressToFil As String
Set ws一覧 = Workbooks("仕入先一覧.xlsx").ActiveSheet
Set ws情報 = Workbooks("仕入先情報.xlsx").ActiveSheet
Rem 埋め込み先の最上段のアドレスを把握する
AddressToFil = Range(ThisWorkbook.Sheets("Sheet1").Range("B1").Value & 1).Resize(1, 3).Address(0, 0)
Set rngSrc = Intersect(ws一覧.Columns("B:C"), ws一覧.Range("C1").CurrentRegion)
Set rngInfo = Intersect(ws情報.Columns("A:D"), ws情報.Range("A1").CurrentRegion)
Application.ScreenUpdating = False '画面更新を一時停止
Rem 埋め込み先を更地化する
ws一覧.Range(AddressToFil).Resize(rngSrc.Rows.Count).ClearContents
For Each cel In rngSrc.Columns(1).Cells
If cel.Value = "*" Then
On Error Resume Next
RW = Application.Match(cel.Offset(, 1).Value2, rngInfo.Columns("A"), 0)
On Error GoTo 0
If IsNumeric(RW) Then
cel.EntireRow.Range(AddressToFil).Value = rngInfo.Cells(RW, 2).Resize(1, 3).Value
End If
End If
Next
Application.ScreenUpdating = True
End Sub
（半平太） 2017/08/03(木) 22:38
ありがとうございます。
書いて頂いた内容を自分なりに理解して
わからない箇所(たくさんありそうです・・。)を質問させて下さい。
まず今の段階で教えて頂きたいことがあります。
マクロをよくわかっていないので、
当たり前のことも聞いてしまうかもしれないのですが、すみません。
●質問１
(1)「仕入先一覧.xlsx」と「仕入先情報.xlsx]は処理対象シートがアクティブになっているものとします。 →これは、ファイルが開いているということですか？
●質問２
Set ws一覧 = Workbooks("仕入先一覧.xlsx").ActiveSheet
Set ws情報 = Workbooks("仕入先情報.xlsx").ActiveSheet
→この2行を実行して、ws一覧とws情報の値を見てみたのですが(表示＞ローカルウィンドウ)、
値は何も入ってなくて、型がWorksheet/Sheet3となっています。
sheet3と言うのはどこから出て来たのかがわからないのです。
●質問３
AddressToFil = Range(ThisWorkbook.Sheets("Sheet1").Range("B1").Value & 1).Resize(1, 5).Address(0, 0)
→この部分がよく理解できないのですが、
「ThisWorkbook.Sheets("Sheet1").Range("B1").Value & 1」は何をしているのか教えて下さい。
「& 1」が特にわからないです。
「& 1」がなければ、マクロを書いてるエクセルのSheet1のB1のセル(値：H)、と言う意味かな、と理解しています。
よろしくお願い致します。
（みかん） 2017/08/04(金) 10:03
＞●質問１ ＞ (1)「仕入先一覧.xlsx」と「仕入先情報.xlsx]は処理対象シートがアクティブになっているものとします。 ＞→これは、ファイルが開いているということですか？
はい、その通りです。
エクセルブックがどのフォルダにあるのか、こちらでは分からないですし、 処理に関連するシート名が何かも分からないので、そうして頂くことにしました。
＞●質問２
＞ Set ws一覧 = Workbooks("仕入先一覧.xlsx").ActiveSheet
＞ Set ws情報 = Workbooks("仕入先情報.xlsx").ActiveSheet
＞→この2行を実行して、ws一覧とws情報の値を見てみたのですが(表示＞ローカルウィンドウ)、
＞ 値は何も入ってなくて、型がWorksheet/Sheet3となっています。
その二つはオブジェクト変数で、処理関連シートオブジェクトを参照しています。
まあ単純に、シートオブジェクト自体と理解して頂いて結構です。
なので、シートには値と言うものは無いです。 ※シートオブジェクトなので、例えばそのシート名を知りたいなら「Name」プロパティを見ればわかります。
その「Sheet3」はシートの型です。(シート名ではありません） 多分、そのシートが最初に出来た時のシート名が「Sheet3」だったのではないかと思います。 シート名を変えても、そこは変わりません。
＞●質問３
＞ AddressToFil = Range(ThisWorkbook.Sheets("Sheet1").Range("B1").Value & 1).Resize(1, 5).Address(0, 0)
Rem 埋め込み先の最上段のアドレスを把握する
AddressToFil = Range(ThisWorkbook.Sheets("Sheet1").Range("B1").Value & 1).Resize(1, 3).Address(0, 0)
~↑~
5じゃなくて3だったと思いますけど？
＞ 「ThisWorkbook.Sheets("Sheet1").Range("B1").Value & 1」は何をしているのか教えて下さい。
＞ 「& 1」が特にわからないです。
＞ 「& 1」がなければ、マクロを書いてるエクセルのSheet1のB1のセル(値：H)、と言う意味かな、と理解しています。
はい、そうです。 「& 1」があるので、"H"と連結して「H1」と言う文字列になります。
すると、Range("H1") が先ず取得できます。(この取得したRangeはどこのシートのでも構いません。目的は以下に書くことなので）。
Rnage("H1").Resize(1, 3) はH1のセルを含めて、1行3列の範囲ですから、Range("H1:J1")と同じになります。
最後にそのAddressプロパティを取りますので、単に"H1:J1"と言う文字列になります。
簡単に言うと、"H"が入っていたら"H1:J1"と言う文字列、 "Z"が入っていたら"Z1:AB1" と言う文字列を作りたかっただけです。
※これが分かっていると、後の方で必要となる書出し範囲を決める時、楽ができると言う寸法です。
（半平太） 2017/08/04(金) 10:52
説明ありがとうございました。
質問２の「Sheet3」はシート名ではなかったんですね。
理解できました。
質問３の「Resize(1, 5)」のところなのですが・・。
取得したいデータが3列から5列に変わったので、Resize(1, 5)にしてみたんです。
他にも変更しないといけない箇所があるかもしれないな、と思いながら、
よくわからないまま、変更してみました。
下の方のIF文の中にある
cel.EntireRow.Range(AddressToFil).Value = rngInfo.Cells(RW, 2).Resize(1, 3).Value
のResize(1, 3)もResize(1, 5)に変更しようと思います。
他にも変更しないといけない箇所がありますでしょうか？
「& 1」の説明、よくわかりました。
ありがとうございました。
全部を理解するのにまだまだ時間がかかりそうです。
また一覧が1データ2行になっていたり、
若干今書いている内容と違うことになりそうなんです。
とりあえずは、今書いて頂いている部分を
理解しようと思いますので、引き続いどうぞよろしくお願い致します。
（みかん） 2017/08/04(金) 16:43
＞質問３の「Resize(1, 5)」のところなのですが・・。 ＞取得したいデータが3列から5列に変わったので ＞下の方のIF文の中にある ＞ cel.EntireRow.Range(AddressToFil).Value = rngInfo.Cells(RW, 2).Resize(1, 3).Value ＞のResize(1, 3)もResize(1, 5)に変更しようと思います。 ＞他にも変更しないといけない箇所がありますでしょうか？
その他は無いです。
そちら事情が変更になって、私のコードを変更した場合は、 その旨を書いて頂かないと、面喰います。
みかんさんの事じゃないですが、自分でコードを変更したのに、 それを言わないで「動きません」と言って来る質問者がいるんですが、 そう言うのはホント困るんです。
（半平太） 2017/08/04(金) 18:44
返信、ありがとうございます。
自分でマクロを変えて、動かなくなってしまったりで質問する時は
使っているマクロをここに貼るようにします。
また、今回作って頂いたマクロなのですが、
エクセルの形式が今思っているのと若干(かなりかも？)違っていたりするので、
今の動きを理解した上で、もう一度やりたいことを整理したいと思います。
一度、マクロを作って頂いたのに本当にすみません。
そして、新たな質問なのですが、よろしくお願い致します。
●質問１
Set rngSrc = Intersect(ws一覧.Columns("B:C"), ws一覧.Range("C1").CurrentRegion)
→これは「仕入先一覧.xlsx」のB列、C列を rngSrc に入れる、イメージで合っているでしょうか？
手作業の場合の、C1のセルを選んで、Ctrl+Shift+"*"で選んだ範囲が rngSrc が入るのかな？と思っていますが、合っているでしょうか？
●質問２
Application.ScreenUpdating = False
→これは何のためにしているのでしょうか？
質問ばかりですみませんが、どうぞよろしくお願い致します。
（みかん） 2017/08/05(土) 11:05
＞質問１
こちらは、A、D、E、・・・列がどうなっているのか分からないので、 明示的にB,C列に限定しました。その2列しか使わないので・・・
＞●質問２
プログラムの第一義は「チャンと結果が出る事」、次が「動作が速い事」です。
今回のケースでは、データ量が不明なので、 どこまで速度を求めるかは回答者のイマジネーション次第です。
私としては、大した量ではないであろうと踏んでいますので、 セルに直接書き込む案にしました。その方が簡単なので。
この方式は一行毎に書き込むので、処理は遅いです。 ただ、データ量が少なければ実務上(体感的)問題になりません。
とは言いながら、書き込む度に画面更新していると「無駄に」遅いので 全行書き終わるまで、画面更新は止めて、速度アップを図るものです。
(処理の正しさには全く影響ありません。但し、描画処理がある場合は大いに影響あり）
（半平太） 2017/08/05(土) 11:39
説明ありがとうございました。
Application.ScreenUpdating = False で画面更新を一時停止している理由がわかりました。
処理速度を上げるために、Forで処理を回している間は画面更新を止めておいて、
処理が終わったら、Application.ScreenUpdating = Trueで戻しているということだったんですね。
理解できました、ありがとうございました。
今扱っているデータは100件くらいなので、多少時間がかかっても問題ないと思うのですが、
勉強になりました。
ありがとうございました。
また質問ですみません。
●質問１
On Error Resume Next
RW = Application.Match(cel.Offset(, 1).Value2, rngInfo.Columns("A"), 0)
→これはエラーの時に
RW = Application.Match(cel.Offset(, 1).Value2, rngInfo.Columns("A"), 0)
の処理をすると言うことでしょうか？
デバックのステップインで処理をしながらRWの値を見ていたら
2、5、6 と確かに「*」の付いている行数が入っていたのですが、
なぜRWにこの数字が入っているのかが理解できていないです。
●質問２
If IsNumeric(RW) Then
cel.EntireRow.Range(AddressToFil).Value = rngInfo.Cells(RW, 2).Resize(1, 3).Value →cel.EntireRow.Range(AddressToFil).ValueにrngInfo.Cells(RW, 2).Resize(1, 3).Valueをセットすると 仕入先一覧.xlsxに値がセットされるようなのですが、 celと仕入先一覧.xlsxは同じものなのでしょうか？ (どう表現して良いのかわからず、うまく伝わらないようでしたら、すみません。)
どうぞよろしくお願い致します。
（みかん） 2017/08/05(土) 22:43
済みません。下記2行は不要でした。消去してください。
On Error Resume Next と On Error GoTo 0
※WorksheetFunction.Match関数と勘違いしました。 (その関数だとエラーで止まることがあるので、その手当の一部を混入させてしまいました。）
このMatch関数は、「*」の右隣の仕入先コードが、情報ブックのA列の何行目にあるか調べるものです。
↓
＞Application.Match(cel.Offset(, 1).Value2, rngInfo.Columns("A"), 0)
でも、情報ブックのA列に存在しないかも知れないですよね？(慎重に考えれば、ですが）
もし不存在なら(プログラムは止まりはしないが）、RWはエラーになります。(存在すれば行番号が入ります)
なので、IsNumeric(RW) で数値かどうかチェックして、 数値なら取引先コードは存在するので、その数値(=行番号)を利用して転記する。
数値じゃないなら(=エラーなら）、存在しないので何もしないで、次の「*」の処理に戻る。
＞ celと仕入先一覧.xlsxは同じものなのでしょうか？
celが何かというと、ここで取り出した一粒のセルですよね。 ↓ ＞ For Each cel In rngSrc.Columns(1).Cells
では、rngSrc.Columns(1).Cells は何かというと、
この範囲の一番左の列(の各セル）ですよね？
↓
＞ Set rngSrc = Intersect(ws一覧.Columns("B:C"), ws一覧.Range("C1").CurrentRegion)
つまり、仕入先一覧のB列(のデータがある範囲）です。 celはその一粒一粒のセルです。(「*」が入っていたり、なかったりのセル）
（半平太） 2017/08/05(土) 23:36
説明ありがとうございました。
理解できたように思います。
マクロをいろいろ触ってみようと思います。
明日以降、変更箇所を含め
やりたいことをちゃんとまとめてみます。
申し訳ありませんが、
引続きどうぞよろしくお願い致します。
（みかん） 2017/08/06(日) 08:52
マクロを触って、いろいろ試してみました。
若干ですが、わかって来た気がします。
ありがとうございます。
やりたいこと、今思っているのと
だいぶ異なるかもしれないですが、
まとめてみますので、よろしくお願い致します。
一番大きな変更点は
仕入先一覧ブックが2行で1明細なところです。
●仕入先一覧ブック
1行目〜6行目は見出し行です。
奇数行と偶数行で1データになっています。
A列 B列 C列 D列
7行目 9999A 8行目 1 仕入先9999A 9行目 10001 10行目 * 1.1 仕入先10001 11行目 20001 12行目 1.2 仕入先30001 13行目 30001 14行目 2 仕入先20001 15行目 40001 16行目 * 2.1 仕入先40001 17行目 50001 18行目 * 3 仕入先50001 ： ：
・A列：奇数行、偶数行共に空白です。
・B列：奇数行：空白
偶数行：仕入先情報からセットしたい行に「*」が入っています。
・C列：奇数行：空白
偶数行：項番が入っています。(1からの連番ではないんです。)
・D列：奇数行：仕入先コードが入っています。(並び順は決まっていないんです。)
偶数行：仕入先名称が入っています。
・E列以降の奇数行には式が入っているので、壊さないようにしたいです。
・偶数行はE列〜？列(☆)までは値が入っているので、壊さないようにしたいです。
☆？列とは・・。
例えば、マクロのシートで「H」と与える場合は、H列の1つ前のG列のことです。
●仕入先情報ブック
1行目〜4行目は見出し行です。
A列 B列 C列 D列 E列 F列 5行目 10001 aaaaa bbbbb ccccc aaaa1 aaaa2 6行目 20001 ddddd eeeee fffff dddd1 dddd2 7行目 30001 ggggg hhhhh iiiii gggg1 gggg2 8行目 40001 jjjjj kkkkk lllll jjjj1 jjjj2 9行目 50001 mmmmm nnnnn ooooo mmmm1 mmmm2 10行目 60001 ppppp qqqqq rrrrr pppp1 pppp2 : : : : : : : :
・A列：仕入先コードが入っています。
・B列〜F列：仕入先の情報が入っています。(5列並んでいます。)
マクロを実行すると仕入先コードをキーに
仕入先情報ブックのB列〜F列のデータを仕入先一覧にセットしたいです。
仕入先情報ブックのセットする位置は
今と同じようにマクロのエクセルのシートでH列とか情報を
与えるようにしたいです。
●実行後の仕入先一覧ブック
マクロのエクセルのシートで「H」を指定した場合
A列 B列 C列 D列 ・・・・ H列 I列 J列 K列 LH列
7行目 9999A 8行目 1 仕入先9999A 9行目 10001 10行目 * 1.1 仕入先10001 aaaaa bbbbb ccccc aaaa1 aaaa2 11行目 20001 12行目 1.2 仕入先20001 13行目 30001 14行目 2 仕入先30001 15行目 40001 16行目 * 2.1 仕入先40001 jjjjj kkkkk lllll jjjj1 jjjj2 17行目 50001 18行目 * 3 仕入先50001 mmmmm nnnnn ooooo mmmm1 mmmm2 ： ：
2行で1明細と言うのがエクセル本来の使い方とは異なるような気がしているのですが、
(私の個人的な感じなのですが・・)既存の資料がこの形でして、
当面はこの資料をそのまま使いたいのです。
こんなデータですが、仕入先一覧を作ることができるでしょうか？
漏れている情報と等ありましたら、書き加えますので、
どうぞよろしくお願い致します。
（みかん） 2017/08/07(月) 17:31
Sub InfoUpdate()
Const numCOLs As Long = 5 '処理すべき列数を定数にして置く
Dim ws一覧 As Worksheet
Dim ws情報 As Worksheet
Dim rngSrc As Range
Dim rngInfo As Range
Dim cel As Range
Dim RW, AddressToFil As String, custCode
Set ws一覧 = Workbooks("仕入先一覧.xlsx").ActiveSheet
Set ws情報 = Workbooks("仕入先情報.xlsx").ActiveSheet
Rem 埋込先の列の1行目のアドレスを把握する
AddressToFil = Range(ThisWorkbook.Sheets("Sheet1").Range("B1").Value & 1).Resize(1, numCOLs).Address(0, 0)
Set rngSrc = ws一覧.Range("B7", ws一覧.Cells(ws一覧.Rows.Count, "D").End(xlUp)) '最下行から上へ向かってデータ最終行を探索
Set rngInfo = ws情報.Range("A5", ws情報.Cells(ws情報.Rows.Count, "A").End(xlUp))
Application.ScreenUpdating = False '画面更新を一時停止
Rem 埋め込み先を更地化する(7行目からクリア←Offsetを6行とする）
ws一覧.Range(AddressToFil).Offset(6).Resize(rngSrc.Rows.Count).ClearContents
Rem 「*」がある行の情報を転記して行く
For Each cel In rngSrc.Columns(1).Cells '一覧シートのB列に「*」があるかチェックする
If cel.Value = "*" Then
If cel.Row Mod 2 = 1 Then '奇数行に「*」があったら処理中止
MsgBox "奇数行(" & cel.Row & ")に[*]あり。処理中止"
Exit Sub
Else '「*」から１つ上、２つ右のセルの取引先コードが情報シートにあるかチェック
custCode = cel.Offset(-1, 2).Value2
RW = Application.Match(custCode, rngInfo.Columns("A"), 0) '該当位置を取得
End If
If IsNumeric(RW) Then '該当行にある情報を転記する
cel.EntireRow.Range(AddressToFil).Value = rngInfo.Cells(RW, 2).Resize(1, numCOLs).Value
End If
End If
Next
Application.ScreenUpdating = True
End Sub
（半平太） 2017/08/07(月) 20:25
早々に作って頂きありがとうございます。
今、動かしてみたところ、1か所だけ修正をお願いしたいところがあります。
仕入先一覧の奇数行(7行目以降)のE列以降は式が入っているので、
壊さないようにしたいんです。
今、動かしてみたら、たとえばマクロのシートで「H」を指定したら
H列〜L列の奇数行の式が消えてしまうようなんです。
作って頂いているのに、いろいろお願いしてすみません。
どうぞよろしくお願い致します。
またマクロの内容はまだじっくり見れてないので、
明日以降見てみて、またわからないところを質問すると思いますが、
引続きよろしくお願い致します。
（みかん） 2017/08/07(月) 21:18
さっき書いた後で思いついたのですが、
「*」の入っている行の埋め込みたいセル5つを更地化する。
たとえば、マクロのシートの値が「H」だったら
「*」の入っている行のH〜L行を更地化してはどうか？
と思ったのですが、これだとまずいでしょうか？
たびたびすみません、よろしくお願い致します。
（みかん） 2017/08/07(月) 21:56
＞ 今、動かしてみたら、たとえばマクロのシートで「H」を指定したら ＞ H列〜L列の奇数行の式が消えてしまうようなんです。
数式は「H」列の左隣りまで、との認識なので、そう作ってあります。
奇数行は消さないと言う条件だと、以下の点が問題になります。
「*」はあるのに、仕入先コードが「情報」シートに無い場合、 その上の行とその行の「H〜L列奇数行と偶数行」はどうするのか？
例:そんなことは起りえないから、どんな作りでも構わない。 奇数行の数式はそのまま残す。 偶数行は何が入っていても消す。 偶数行もそのまま残す。
＞「*」の入っている行の埋め込みたいセル5つを更地化する。
そこは、いずれにしても上書きするので、基本的には何もする必要がないです。 上で述べたケースの時(「*」があるのに、情報シートには無い時）だけ問題になります。(上書きに行かないので）
（半平太） 2017/08/07(月) 22:02
おはようございます。
返信ありがとうございます。
私の考え不足な点が多々ありました。
後から書き足した更地化については特に・・。
すみません。
＞ 奇数行は消さないと言う条件だと、以下の点が問題になります。
＞
＞ 「*」はあるのに、仕入先コードが「情報」シートに無い場合、
＞ その上の行とその行の「H〜L列奇数行と偶数行」はどうするのか？
以下の条件では上手く動かさせるでしょうか？
・奇数行の数式はそのまま残す
・偶数行は「*」が入っている場合は、情報シートからデータをセットする
・偶数行は「*」が入っているけど情報シートに存在ない場合は、更地化したまま(空白)にする
・偶数行で「*」が入っていない場合は、何もセットしない(元のままの値を残す)
今日は終日、外に出ていてパソコン触れないと思うので
返信が遅くなると思うのですが、どうぞよろしくお願い致します。
（みかん） 2017/08/08(火) 06:52
Sub InfoUpdate()
Const numCOLs As Long = 5 '処理すべき列数を定数にして置く
Dim ws一覧 As Worksheet
Dim ws情報 As Worksheet
Dim rngSrc As Range
Dim rngInfo As Range
Dim cel As Range
Dim RW, AddressToFil As String, custCode
Set ws一覧 = Workbooks("仕入先一覧.xlsx").ActiveSheet
Set ws情報 = Workbooks("仕入先情報.xlsx").ActiveSheet
Rem 埋込先の列の1行目のアドレスを把握する
AddressToFil = Range(ThisWorkbook.Sheets("Sheet1").Range("B1").Value & 1).Resize(1, numCOLs).Address(0, 0)
Set rngSrc = ws一覧.Range("B7", ws一覧.Cells(ws一覧.Rows.Count, "D").End(xlUp)) '最下行から上へ向かってデータ最終行を探索
Set rngInfo = ws情報.Range("A5", ws情報.Cells(ws情報.Rows.Count, "A").End(xlUp))
Application.ScreenUpdating = False '画面更新を一時停止
For Each cel In rngSrc.Columns(1).Cells '一覧シートのB列に「*」があるかチェックして行く
If cel.Value = "*" Then
If cel.Row Mod 2 = 1 Then '奇数行に「*」があったら処理中止
MsgBox "奇数行(" & cel.Row & ")に[*]あり。処理中止"
Exit Sub
Else '「*」から１つ上、２つ右のセルの取引先コードが情報シートにあるかチェック
custCode = cel.Offset(-1, 2).Value2
RW = Application.Match(custCode, rngInfo.Columns("A"), 0) '該当位置を取得
End If
If IsNumeric(RW) Then
cel.EntireRow.Range(AddressToFil).Value = rngInfo.Cells(RW, 2).Resize(1, numCOLs).Value
Else
cel.EntireRow.Range(AddressToFil).Value = Empty
End If
End If
Next
Application.ScreenUpdating = True
End Sub
（半平太） 2017/08/08(火) 09:13
ありがとうございます。
今動かしてみたら、欲しい結果になっているように思います。
今日は遅くなってしまったので、
明日以降で理解しながら見させて頂きたいと思います。
引続きどうぞよろしくお願い致します。
（みかん） 2017/08/08(火) 23:53
いろいろ試してみて、希望する一覧を作成することができています。
本当にありがとうございました。
マクロの処理の中でわからない箇所がたくさんありまして、
教えて頂きたく、よろしくお願いします。
●質問1
'最下行から上へ向かってデータ最終行を探索 の行の
Set rngInfo = ws情報.Range("A5", ws情報.Cells(ws情報.Rows.Count, "A").End(xlUp))
の"A"を"B"や"F"に変更しても結果は同じでしょうか？
A列からF列は仕入先情報のデータが入っているので
変更しても同じ結果になるかも？と思い、
テストしてみたら同じようなのですが、念のため確認させて下さい。
●質問2
・cel.Value = "*"
・custCode = cel.Offset(-1, 2).Value2
と言った cel のことがよくわかりません。
○特にcel.Valueは、表示＞ローカルウィンドウで見たところ
Value2はあるのですが、Valueがないようなんです。
(Validationの中にはあるのですが、このことでしょうか？)
○offsetと言うのがよくわかっていないので、
どういう処理をしているのか教えて頂けるでしょか。
(custCodeに仕入先コードが入っていることは確認できたのですが、
どうして仕入先コードが入ったのかがわからないんです。)
●質問3
仕入先情報ブックに仕入先コードが見つからなかった時
仕入先一覧の項目にゼロをセットしたいので、以下に変更しました。
問題はないか、念のため確認させて下さい。
cel.EntireRow.Range(AddressToFil).Value = Empty
↓ ↓ ↓
cel.EntireRow.Range(AddressToFil).Value = 0
●質問4
Rem 埋込先の列の1行目のアドレスを把握する
AddressToFil = Range(ThisWorkbook.Sheets("Sheet1").Range("B1").Value & 1).Resize(1, numCOLs).Address(0, 0)
マクロのシートのB列に「H」と指定した場合、
この処理で AddressToFil に "H1:L1" と入るのは確認できたのですが、
どうして入るのかが理解できていません。
イコールの右側が理解できていないんです。
どのような処理をしているのか教えて頂けないでしょうか。
●質問5
If IsNumeric(RW) Then
cel.EntireRow.Range(AddressToFil).Value = rngInfo.Cells(RW, 2).Resize(1, numCOLs).Value
この部分も質問4と同じような感じでイコールの右側が理解できていません。
こちらもどのような処理をしているのか教えて頂けないでしょうか。
質問ばかりで申し訳ありませんが、どうぞよろしくお願い致します。
（みかん） 2017/08/10(木) 16:13
＞●質問1
＞'最下行から上へ向かってデータ最終行を探索 の行の
＞ Set rngInfo = ws情報.Range("A5", ws情報.Cells(ws情報.Rows.Count, "A").End(xlUp))
＞の"A"を"B"や"F"に変更しても結果は同じでしょうか？
＞A列からF列は仕入先情報のデータが入っているので
＞変更しても同じ結果になるかも？と思い、
＞テストしてみたら同じようなのですが、念のため確認させて下さい。
結果は同じかも知れません。
私は、A列からF列まで、全てデータで埋まっていると言うそちらの状況は知らないので、 確実にデータが入っているであろうA列を最下行探索に使ったものです。
＞●質問2 ＞・cel.Value = "*" ＞・custCode = cel.Offset(-1, 2).Value2 ＞と言った cel のことがよくわかりません。
変数 cel については、以前に説明済みです。
＞○特にcel.Valueは、表示＞ローカルウィンドウで見たところ ＞ Value2はあるのですが、Valueがないようなんです。
確かにValueはないですね。よく使うのに・・・
Value2と同じと思ってください。つまりセルの値です。
違いは、日付データになると、ValueがDate型、Value2がDounble型となる。 詳しくはヘルプで調べてください。
＞○offsetと言うのがよくわかっていないので、 ＞ どういう処理をしているのか教えて頂けるでしょか。 ＞ (custCodeに仕入先コードが入っていることは確認できたのですが、 ＞ どうして仕入先コードが入ったのかがわからないんです。)
celは「*」が入っているセルですよね。
そこから一つ上の行、２つ右の列に仕入先コードが入っていますよね？ そういう状況の時、cel.Offset(-1,2)と書けば、仕入れ先コードの入っているセルに辿り着けます。 ↑ ↑ マイナス1なので上に一つずれる。プラス2なので右に2つずれる
＞●質問3 問題ありません。
＞●質問4
＞Rem 埋込先の列の1行目のアドレスを把握する
＞ AddressToFil = Range(ThisWorkbook.Sheets("Sheet1").Range("B1").Value & 1).Resize(1, numCOLs).Address(0, 0)
＞マクロのシートのB列に「H」と指定した場合、
＞この処理で AddressToFil に "H1:L1" と入るのは確認できたのですが、
＞どうして入るのかが理解できていません。
＞イコールの右側が理解できていないんです。
＞どのような処理をしているのか教えて頂けないでしょうか。
これも以前、説明済みです。
Range(ThisWorkbook.Sheets("Sheet1").Range("B1").Value & 1).Resize(1, numCOLs).Address(0, 0)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~(1)~~~~~~~~~~~~~~~~~~~ ~~~~~(2)~~~~~~~~~~ ~~(3)~~~~~~~
(1) "H"を取得して、1を付け足す。"H1"になる
(2) Range("H1")を基準にしたResizeプロパティ(1行ｘ5列）を取得する。→Range("H1:L1")オブジェクトが取得できる。
(3) Range("H1:L1")のアドレスを文字列で格納する。 AddressToFilに"H1:L1"の文字が入る。
＞●質問5 ＞If IsNumeric(RW) Then ＞ cel.EntireRow.Range(AddressToFil).Value = rngInfo.Cells(RW, 2).Resize(1, numCOLs).Value ＞この部分も質問4と同じような感じでイコールの右側が理解できていません。
RWには目的の仕入先が存在する位置番号が入っています。
その行位置の、B列からF列(5列分）を転記することになります。
右辺 =rngInfo.Cells(RW, 2).Resize(1, numCOLs).Value ~~~~~~~~~(1)~~~~~~~~ ~~~~~~~~~~(2)~~~~~~~~~~~~
(1)rngInfoのセル範囲で、RWの位置にある2列目のセル (2)上記(1）のセルのResize(1行x5列）の値配列を取得
左辺 cel.EntireRow.Range(AddressToFil).Value = ~~~~~~(1)~~~ ~~~~~~(2)~~~~~~~~~~~~~~~~
(1)「*」のセルの行全体(1行全体)
(2) その行のRange("H1:L1")の範囲 → もし「*」が8行目にあれば、Range("H8:L8")に値を入力する
↑
1行目に見えるが、土台(cel)が8行目にあるので、相対的な位置であるH8:L8 になることに留意
（半平太） 2017/08/10(木) 19:34
返信ありがとうございました。
一度説明して頂いたのに理解が不十分な箇所もあり、すみません。
もう一度良く見なおしてみます。
また改めて質問すると思いますので、どうぞよろしくお願い致します。
（みかん） 2017/08/10(木) 22:05
説明して頂いた内容を自分なりに理解してみました。
たくさん気付いた部分があり、とても勉強になりました。
ありがとうございました。
理解して行く中で新たに質問させて頂きたいことや
新たな質問が出て来たので、すみませんがよろしくお願い致します。
●質問1
ValueとValue2について、調べてみました。
今回扱っているデータは通貨型でも日付型でもないので、同じデータが入っていると言うことなんですね。
Valueの箇所をValue2に変えたり、Value2の箇所をValueに変えたりしてマクロを動かしてみたら、同じ結果のようです。
そこで
cel.Value = "*" → cel.Value2 = "*" もしくは cel.Offset(-1, 2).Value2 → cel.Offset(-1, 2).Value にしても問題ないでしょうか？
問題ないなら、ValueかValue2、どちらに合わせておきたいと思っています。
ValueかValue2、どちらに合わせるのが良いかお薦めとかあれば教えて下さい。
●質問2
私が全く理解できていなかった
・Range(ThisWorkbook.Sheets("Sheet1").Range("B1").Value & 1).Resize(1, numCOLs).Address(0, 0)
・rngInfo.Cells(RW, 2).Resize(1, numCOLs).Value
の部分も理解できたと思います。
各文の一番最後の「Address(0, 0)」や「Value」は左側の項目にどう言う値をセットするかと言う属性？のような情報と
理解したのですか合っているでしょうか？
●質問3
マクロが動くようになって来たら、だんだんと欲が出て来てしまいました。
すみませんが・・、以下のようなことはできるでしょうか？
仕入先一覧.xlsxの中にたくさんシートがありまして、今回教えて頂いた処理を実行したいシートが複数あります。
(各シートの項目のレイアウトは全て同じです。)
シート名の先頭に「○」(たとえば「○仕入先(AAA)」「○仕入先(BBB)」)を付けるので、
マクロを処理することでシート名の先頭に「○」が付いているシート全てにこの処理をすると言うことはできるでしょうか？
たくさん教えて頂いて、まだ質問やお願いをするのが心苦しく思っています。
その分、自分も勉強したいと思っていますので、どうぞよろしくお願い致します。
（みかん） 2017/08/12(土) 09:53
＞●質問1
通常は「Value」で統一します。
その方が、適切なデータ型になってくれることが多いので。
ただ、Date型の場合、「却ってトラブルの原因になることが稀にある」と覚えておいてください。
＞●質問2 ＞各文の一番最後の「Address(0, 0)」や「Value」は左側の項目にどう言う値をセットするかと言う属性？のような情報と ＞理解したのですか合っているでしょうか？
まさしくオブジェクトが持っている「属性」です。プロパティと呼んでいます。 返してくる属性は、スカラー値(1,2・・、"あ"、"い"、・・）もあれば、オブジェクト(セル、シート、・・）もあります。
＞●質問3 ＞仕入先一覧.xlsxの中にたくさんシートがありまして、今回教えて頂いた処理を実行したいシートが複数あります。 ＞(各シートの項目のレイアウトは全て同じです。) ＞シート名の先頭に「○」(たとえば「○仕入先(AAA)」「○仕入先(BBB)」)を付けるので、 ＞マクロを処理することでシート名の先頭に「○」が付いているシート全てにこの処理をすると言うことはできるでしょうか？
可能ですけど、「○」を付ける手作業が面倒で実用的じゃないと思います。
それとも「○」を付けると言ったのは行きがかり上であって、 実際は○に相当するものが既に付いているんですか？
それ如何で、処理の組み立てが変わります。
（半平太） 2017/08/12(土) 15:07
返信ありがとうございました。
●質問1、●質問2の返信の内容は覚えておくようにします。
●質問3のシート名の「○」なのですが、今は付いていないんです。
処理をしたいシートと処理をしたくないシートを区別する何かが必要かな、と思って
「○」を付けることを思い付いたんです。
と言うか、他の案を持ち合わせておらず、シートは10シートくらいなので手作業で
「○」を付けようと思ったんです。
もちろん、他にもっと良い案があれば、そちらでやった方がいいと思いますし、
何か良い案があれば、ぜひ教えて下さい。
どうぞよろしくお願い致します。
（みかん） 2017/08/12(土) 20:28
さっき書いた後に思いついた案があるのですが、
これは使えそうでしょうか？
マクロブックの<Sheet1>の2行目に対象シートを入力しては
どうかと思いました。
行 ______A______ _B_ _C_ _D_ _E_ ・・・・・ 1 書出し列番号 H 2 対象シート 3 4 6 8 ・・・・・
B列：開始シート1 3シート目
C列：終了シート1 4シート目
D列：開始シート2 6シート目
E列：終了シート2 8シート目
: ： ： : ： ：
B列、C列がセット、D列、E列がセットで開始シートと終了シートを指定し
この繰り返しが続くイメージです。
上の例だと3シート目、4シート目、6シート目、7シート目、8シート目が
処理の対象になるイメージです。
他にもっと良い案があれば、教えて下さい。
どうぞよろしくお願い致します。
（みかん） 2017/08/12(土) 22:41
＞処理をしたいシートと処理をしたくないシートを区別する何かが必要かな、と思って ＞「○」を付けることを思い付いたんです。
そう気づいてもらえただけで私はうれしい。
・・で、私の案ですけど、以下(1)→(2)→(3)の流れにする
(1)仕入先一覧.xlsxにあるシート名を全て書出すマクロを作って マクロブックのSheet1のC列に書き出させる。
(2)オペレータが、処理対象のシート名の右隣に「1」を手入力する。
<Sheet1> 行 ______A______ _B_ _____C_____ ___D___ 1 書出し列番号 H シート名 1=対象 2 仕入先(AAA) 1 ←１は手入力 3 仕入先(BBB) 1 4 仕入先(CCC)
(3) いままでのマクロを実行する。 ただし、処理対象が複数になったので、対象シートを繰り返し処理するように改変する。
※なお、処理対象が複数になったので、 仕入先一覧.xlsx は開いてあるだけでいいです。何のシートがアクティブかは問わない。 仕入先情報.xlsx は(引き続き）処理対象シートがアクティブになっているものとします。
Sub 全シート名書き出し()
Dim ThisWs As Worksheet, RW As Long, NumWs As Long
Set ThisWs = ThisWorkbook.Sheets("Sheet1")
ThisWs.Columns("C:D").ClearContents 'シート名書き出し先を更地化
RW = 1 '初期化
With Workbooks("仕入先一覧.xlsx")
ThisWs.Range("C1:D1").Value = Array("シート名", "1=対象")
For NumWs = 1 To .Sheets.Count
RW = RW + 1
ThisWs.Cells(RW, "C").Value = .Sheets(NumWs).Name
Next NumWs
End With
End Sub
Sub InfoUpdate() '対象となるシート名の右欄(D列）に1を入力したら、実行する
Dim ThisWs As Worksheet, cel As Range
Set ThisWs = ThisWorkbook.Sheets("Sheet1")
For Each cel In ThisWs.Range("C2", ThisWs.Cells(10000, "C").End(xlUp))
If cel.Offset(0, 1) = 1 Then 'D列に1がある時だけ処理する
Call InfoUpdateOld(cel.Value) 'シート名を渡して、更新処理を実行させる
End If
Next
MsgBox "完了"
End Sub
Private Sub InfoUpdateOld(対象シート名 As String) ’以前のマクロ。今度は単独では実行しない。
’InfoUpdateからシート名を渡されたら実行する
Const numCOLs As Long = 5 '処理すべき列数を定数にして置く
Dim ws一覧 As Worksheet
Dim ws情報 As Worksheet
Dim rngSrc As Range
Dim rngInfo As Range
Dim cel As Range
Dim RW, AddressToFil As String, custCode
Set ws一覧 = Workbooks("仕入先一覧.xlsx").Sheets(対象シート名) '←ここを変更した
Set ws情報 = Workbooks("仕入先情報.xlsx").ActiveSheet
Rem 埋込先の列の1行目のアドレスを把握する
AddressToFil = Range(ThisWorkbook.Sheets("Sheet1").Range("B1").Value & 1).Resize(1, numCOLs).Address(0, 0)
Set rngSrc = ws一覧.Range("B7", ws一覧.Cells(ws一覧.Rows.Count, "D").End(xlUp)) '最下行から上へ向かってデータ最終行を探索
Set rngInfo = ws情報.Range("A5", ws情報.Cells(ws情報.Rows.Count, "A").End(xlUp))
Application.ScreenUpdating = False '画面更新を一時停止
For Each cel In rngSrc.Columns(1).Cells '一覧シートのB列に「*」があるかチェックして行く
If cel.Value = "*" Then
If cel.Row Mod 2 = 1 Then '奇数行に「*」があったら処理中止
MsgBox "奇数行(" & cel.Row & ")に[*]あり。処理中止"
Exit Sub
Else '「*」から１つ上、２つ右のセルの取引先コードが情報シートにあるかチェック
custCode = cel.Offset(-1, 2).Value2
RW = Application.Match(custCode, rngInfo.Columns("A"), 0) '該当位置を取得
End If
If IsNumeric(RW) Then
cel.EntireRow.Range(AddressToFil).Value = rngInfo.Cells(RW, 2).Resize(1, numCOLs).Value
Else
cel.EntireRow.Range(AddressToFil).Value = 0
End If
End If
Next
Application.ScreenUpdating = True
End Sub
（半平太） 2017/08/12(土) 22:59
＞さっき書いた後に思いついた案があるのですが、 ＞これは使えそうでしょうか？
そちらのレスを読む前に私の案をアップしましたので、 私の案について改善の余地がありましたら追加レスをお願いします。
（半平太） 2017/08/12(土) 23:37
おはようございます。
マクロ、ありがとうございました。
今、動かしてみたら、欲しい結果が出ています。
こう言うやり方があることに気付きませんでした。
とても勉強になりました。
最後に「完了」って出るのがとても嬉しいです。
もう少し動かしてみて、
マクロの内容も理解して行こうと思います。
マクロの内容のことでまた質問すると思いますが、
引続きよろしくお願い致します。
あと、今、手作業で作成している他の資料も
マクロを使うようにして行きたいと思っています。
こんなに親切に教えて頂けるのは本当に嬉しいですし、
有難いことなのですが、自分でも勉強してみようと思います。
どれだけ勉強してもここで質問するレベルだと思うのですが、
教えてもらった内容をちゃんと理解できるレベルになりたいな、
と思ってます。
「たった1秒で仕事が片づく Excel自動化の教科書」と言う本を
昨日本屋さんで見つけて、これで一通り勉強してみようかな？
と思ったんですけど、昨日は買わなかったです。
もし半平太様が初心者にお薦めの本があれば教えてもらいたいな、
と思いまして。
このサイトでこう言う質問をするのがふさわしくないようでしたら
ごめんなさい。
よろしくお願い致します。
（みかん） 2017/08/13(日) 07:49
＞このサイトでこう言う質問をするのがふさわしくないようでしたら ＞ごめんなさい。
どうなんでしょうね？ 宣伝臭くなければ、問題ないと思いますけど。
ここまで伸びたスレで言い出すのもなんですが、 ＞半平太様 「さん」づけでお願いします。「様」は私には重すぎます。
＞初心者にお薦めの本があれば 最近、初心者用の本を読んだことありません。 人によっても、合う合わないがあるでしょうしね。
昔、読んだのは大村あつし氏の「簡単プログラミング」(略して「簡プロ」シリーズ） 今、売っているかどうか分かりません。
実践的なのは「そのまま使える実用マクロ500連発」ですね。 息子に譲ったので、手元にないですけど。
＞「たった1秒で仕事が片づく Excel自動化の教科書」と言う本を ＞昨日本屋さんで見つけて、これで一通り勉強してみようかな？
ネーミングは最高ですね。エクセルの価値は、どれだけ仕事を簡単にできるかですから。
ただ、「一通り勉強してみよう」と言う方針は、 (それが出来れば、それに越したことはないですが、少なくとも私は）続かないです。
500連発と同じで、現在必要とされるシーンのページを探して読む方が、効率的に身に付きます。
（半平太） 2017/08/13(日) 12:09
返信ありがとうございます。
今回から半平太さんと呼ばせて下さい。
今日はマクロについて、あまり深堀する時間がなかったので、
また改めて質問させて下さい。
本については、確かに人によって合う合わないがあると思います。
半平太さんに教えて頂いた本を参考に自分に合うものを探したいと思います。
＞現在必要とされるシーンのページを探して読む方が、効率的に身に付きます。
実は・・、基礎的なことを一通り勉強するのもいいけど
やりたいことから辞書的に使えるもの(？)がいいのかな、とも思っていたんです。
そのあたりも含めて、本屋さんで実物見ながら決めてみます。
ありがとうございました。
今、お盆休みでマクロを本物のデータで動かすことができない状況です。
(テスト的なデータでは家で確認してみて、上手く動いています！)
次の質問まで数日あくかもしれないですが、どうぞよろしくお願い致します。
（みかん） 2017/08/13(日) 22:21
お世話になってます。
いくつか質問をさせて下さい。
●質問1
For NumWs = 1 To .Sheets.Count
→最後のシートまで処理するようにしているんだろうな、と思うのですが、
「.Sheets.Count」の「.」から始まるのは何か特別な意味(？)のようなものがあるのでしょうか？
●質問2
For 〜 Nextで処理しているところについてなのですが、
For を終わらせるNextに
・Next 変数名
・Next
2パターンありまして、この違いについて、以下のように理解してみましたが
合っているでしょうか？
○パターン1：(NumWsがLong属性)
For NumWs = 1 To .Sheets.Count
：
Next NumWs
・処理を回すのを Long属性 の変数を使っている時は「Next 変数名」で終わる
→ここで変数名に +1 している
○パターン2：(celがRange属性)
For Each cel In ThisWs.Range("C2", ThisWs.Cells(10000, "C").End(xlUp))
：
Next
・処理を回すのを Range属性の変数を使っている時は「Next」で終わる
→Range属性の時は +1 を意図的にしなくても自動的にされている
●質問3
For Each cel In ThisWs.Range("C2", ThisWs.Cells(10000, "C").End(xlUp))
→処理をマクロのシートのC列(シート名)が入っている箇所まで処理をするために
C列の10000行目から上へ向かってデータ最終行を探索していると
言う理解で合っているでしょうか？
※ws一覧.Range("B7", ws一覧.Cells(ws一覧.Rows.Count, "D").End(xlUp)) '最下行から上へ向かってデータ最終行を探索
と似てるので・・。
と言うことは、以下にしても同じ結果でしょうか？
For Each cel In ThisWs.Range("C2", ThisWs.Cells(ThisWs.Rows.Count, "C").End(xlUp))
自分でやってみたところ、同じ結果に見えているのですが、念のため確認をさせてください。
よろしくお願い致します。
（みかん） 2017/08/15(火) 19:24
＞●質問1 ＞For NumWs = 1 To .Sheets.Count ＞→最後のシートまで処理するようにしているんだろうな、と思うのですが、 ＞ 「.Sheets.Count」の「.」から始まるのは何か特別な意味(？)のようなものがあるのでしょうか？
それは、With ○○ 〜 End With の間に書かれます。
その間にある時は、いちいち ○○.Sheets.Count とか、書かなくて済みます。 つまり、「○○.」と書かなければならない行が沢山ある場合、面倒なので省略する、と言うことです。
「.」が無いと、Withの間に書かれていても、何の神通力もありません。 単に、その時アクティブになっているブックのSheetsになってしまい、予期せぬ結果になります。
「○○」は種々のオブジェクトで活用出来ます。ブックに限った話ではないです。
＞●質問2 ＞For 〜 Nextで処理しているところについてなのですが、
Nextの次に書く「カウンタ」または「エレメント」はいずれも省略できます。
どう云う訳か、一般に「For」は省略せず、「For Next」は省略しています。 「For」は入れ子にすることが珍しくない為、明示しているのかも知れませんが、 理由はよく分かりません。m(__)m
＞○パターン1：(NumWsがLong属性) ＞ →ここで変数名に +1 している
OKです。
＞○パターン2：(celがRange属性) ＞ →Range属性の時は +1 を意図的にしなくても自動的にされている
数値じゃないので「+1」と言のはちょっと違います。 コレクション(集合体）の中で並んでいる次のエレメント(構成員）です。 エクセルが自動的に見繕って出して来ます。(何個あるか知らなくても使えますね）
＞●質問3
＞For Each cel In ThisWs.Range("C2", ThisWs.Cells(10000, "C").End(xlUp))
＞→処理をマクロのシートのC列(シート名)が入っている箇所まで処理をするために
＞ C列の10000行目から上へ向かってデータ最終行を探索していると
＞ 言う理解で合っているでしょうか？
OKです。結局、「C2〜データ最終行」のRangeとなります。
＞以下にしても同じ結果でしょうか？
＞ For Each cel In ThisWs.Range("C2", ThisWs.Cells(ThisWs.Rows.Count, "C").End(xlUp))
同じです。・・と言うより、そちらの方が正確です。 私は、面倒なので10000行からやっても十分とみて、ズルしただけです。
（半平太） 2017/08/15(火) 20:47
説明ありがとうございました。
せっかく説明して頂いたのに、1か所よく理解できない箇所があるんです。
＞ どう云う訳か、一般に「For」は省略せず、「For Next」は省略しています。
この箇所なのですが、もう少し説明して頂くことはできるでしょうか？
どうぞよろしくお願い致します。
その他の部分は、とてもわかりやすく、ストンと胸に落ちる感じで理解できました。
ありがとうございました。
（みかん） 2017/08/15(火) 21:46
「Next 変数名」と 「Next」 の2パターンある理由ですね？
「Next」の右の変数を書くか、省略するかです。
ヘルプ抜粋 ※ [ ] は任意を意味します。書いても書かなくてもいい。 ↓ ＞For counter = start To end [Step step] ＞Next [counter]
＞For Each element In group ＞Next [element]
理由は分からないですが、一般に [counter]は明記し、[element]は省略することが多いです。
counterは数値型、elementはgroupの構成要素の型です。 ↓ ↓ プラス1する 次の要素をセットする
（半平太） 2017/08/16(水) 12:45
説明ありがとうございました。
理解できました。
今日から仕事でして、会社で本物のデータで動かしてみました。
思った通りの結果になっていることを確認できました。
初心者の私にわかりやすく説明して下さり、
また質問後、数時間で返信下さったのも、とてもありがたかったです。
本当にありがとうございました。
これからも私の質問を見かけましたら、どうかお力を貸して下さい。
今後ともどうぞよろしくお願い致します。
（みかん） 2017/08/16(水) 17:04
ご無沙汰しています。
以前作って頂いたマクロを参考に、自分で以下のマクロを作ってみたのですが、
うまく動かないので助けて下さい。
(半平太さんが気付いてくれることを期待して！)
自分で作ったと言うのは以下の処理です。
以前に作成して頂いたマクロを実行する前に、
実は列を手動で追加したり、貼り付けしている箇所がありまして
その部分を追加したいと思ったんです。
1．ある場所(★1)に6行挿入し、元のセルは6列右に移動させる。
(参考) 6列で1カ月分のデータになっているので、
処理を6列単位で行いたいです。
*1〜5列目：明細データ数
*6列目：合計(1〜5列の明細データ数の合計)で、式が入っています。
(例)マクロのシートで'H'を与えるとH〜M列が挿入される。
2. 'H'列から6個右隣の列から12列分をH列〜12列分にコピーする。
(例)上の例の続きの場合、N列〜Y列がH列〜S列にコピーされる。
結果として
・列が6列増える
・H列〜M列は元の値のまま
・N列〜S列とT列〜Y列は同じ内容になる
と言ったイメージです。
★1:ある場所を言うのは、今マクロのシートのB1セルで与えている貼り付け位置のように
毎回処理をするたびに変わるので、今回はこの挿入位置を
マクロのシートで与えるようにしたいと思っています。
また今はB1セルに記入しているのですが、B2セルに移動させたいと思っています。
(1行目はタイトル行にしようと思いまして。）
それで自分で以下のマクロを作ってみました。
動かしてみると、マクロのシートのD列(1=対象)に'1'が付いてるかどうかに関係なく
今開いているシートに列が追加されてしまいます。
また追加される列数はD列(1=対象)に'1'が付いている数分、
今開いているシートに列が追加されてコピーされているようなのです。
(D列(1=対象)に'1'が3つ付いていたら、18列追加されます。)
================================================================
Sub InfoUpdate() '対象となるシート名の右欄(D列）に1を入力したら、実行する
Dim ThisWs As Worksheet, cel As Range
Set ThisWs = ThisWorkbook.Sheets("Sheet1")
' For Each cel In ThisWs.Range("C2", ThisWs.Cells(10000, "C").End(xlUp))
For Each cel In ThisWs.Range("C2", ThisWs.Cells(ThisWs.Rows.Count, "C").End(xlUp))
If cel.Offset(0, 1) = 1 Then 'D列に1がある時だけ処理する
Call InfoUpdateOld(cel.Value) 'シート名を渡して、更新処理を実行させる
End If
Next
MsgBox "完了"
End Sub
Private Sub InfoUpdateOld(対象シート名 As String) '以前のマクロ。今度は単独では実行しない。
'InfoUpdateからシート名を渡されたら実行する
Const numCOLs As Long = 5 '処理すべき列数を定数にして置く (データ分)
Const numCOLs2 As Long = 6 '処理すべき列数を定数にして置く (列挿入分)
Const numCOLs3 As Long = 12 '処理すべき列数を定数にして置く (列挿入時コピー分)
Dim ws一覧 As Worksheet
Dim ws情報 As Worksheet
Dim rngSrc As Range
Dim rngInfo As Range
Dim cel As Range
Dim RW, AddressToFil, AddressToFil2, AddressToFil3 As String, custCode
Set ws一覧 = Workbooks("仕入先一覧.xlsx").Sheets(対象シート名) '←ここを変更した
Set ws情報 = Workbooks("仕入先情報.xlsx").ActiveSheet
Rem 埋込先の列の1行目のアドレスを把握する (貼り付け位置)
AddressToFil = Range(ThisWorkbook.Sheets("Sheet1").Range("B2").Value & 1).Offset(0, 12).Resize(1, numCOLs).Address(0, 0)
Rem 挿入先の列の1行目のアドレスを把握する (挿入位置)
AddressToFil2 = Range(ThisWorkbook.Sheets("Sheet1").Range("B2").Value & 1).Resize(1, numCOLs2).Address(0, 0)
Rem 行挿入
Range(AddressToFil2).EntireColumn.Insert
Rem 前々月、前月コピー
AddressToFil3 = Range(ThisWorkbook.Sheets("Sheet1").Range("B2").Value & 1).Offset(0, 6).Resize(1, numCOLs3).Address(0, 0)
Application.DisplayAlerts = False
Range(AddressToFil3).EntireColumn.Copy Destination:=Range(AddressToFil2).EntireColumn
Application.DisplayAlerts = True
End Sub ================================================================
処理したい内容が上手く伝わっているといいのですが、
もしわかりにくい点があれば、また書きますのでよろしくお願いします。
またマクロもあまりわからないまま作ってみたので、
おかしな部分がたくさんあると思うので、どう書いたらいいかなども
教えてもらえると嬉しいです。
どうぞよろしくお願いいたします。
（みかん） 2017/09/09(土) 11:32
＞動かしてみると、マクロのシートのD列(1=対象)に'1'が付いてるかどうかに関係なく ＞今開いているシートに列が追加されてしまいます。 ＞また追加される列数はD列(1=対象)に'1'が付いている数分、 ＞今開いているシートに列が追加されてコピーされているようなのです。 ＞(D列(1=対象)に'1'が3つ付いていたら、18列追加されます。)
処理対象がどのシートなのか、チャンと特定していないからです。
＞ Rem 行挿入
＞ Range(AddressToFil2).EntireColumn.Insert
↓
ws一覧.Range(AddressToFil2).EntireColumn.Insert '←シートを特定して列挿入する
＞ Application.DisplayAlerts = False
＞ Range(AddressToFil3).EntireColumn.Copy Destination:=Range(AddressToFil2).EntireColumn
↓ ↓
ws一覧.Range(AddressToFil3).EntireColumn.Copy Destination:=ws一覧.Range(AddressToFil2).EntireColumn
じゃ、なんでこれは、Rangeの前にシートを特定しなくて良かったのか？・・ と言う疑問が生じますよね？
↓
＞ Rem 挿入先の列の1行目のアドレスを把握する (挿入位置)
＞ AddressToFil2 = Range(ThisWorkbook.Sheets("Sheet1").Range("B2").Value & 1).Resize(1, numCOLs2).Address(0, 0)
特定する方が正式なのでしょうが・・、
何行目の何列目と言うアドレスは、どのシートであっても同じアドレス文字を返して来ます。 例えば、4行目の3列目のアドレスは、どのシートでも「C4」です。
・・なので、そこはシートを特定しなくても正常に動くのです。
（半平太） 2017/09/09(土) 13:32
ありがとうございました！
思い通りに動くようになりました。
シートを指定していなかったから、今開いているシートに列が追加されて行ったんですね。
そして、アドレスを取る時はどのシートから取っても同じ値が返させる。
理解できました。
私が初めて作ったマクロ、上手く動きはしなかったものの
大きくは間違っていなかったようで、とても嬉しいです。
これからも少しずつ作ってみようと思っていますので、また困った時は助けて下さい！
どうぞよろしくお願いいたします。
（みかん） 2017/09/09(土) 15:06
お世話になります。
また仕入先一覧でマクロで新しいことをできないか、と思いまして、
どうかお力を貸して下さい。
仕入先一覧のファイルの中に、
各仕入先一覧の合計のみ表示されているシートがあるんです。
●シートの並び
1シート目：合計シート
2シート目：仕入先一覧(A社)
3シート目：仕入先一覧(B社)
4シート目：仕入先一覧(C社)
： ： ：
今は、仕入先一覧の各シート(今のマクロで作成しているシート)の合計(*1)から
合計のシートに手でコピペして作成しています。
これをまたマクロで作れないかなと思っています。
今作成しているマクロとは別のマクロで作成したいと思っていて
書き込みする列をマクロのシートで指定するのは同じ方法でと思っています。(*2)
行 ______A______ _B_ 1 書出し列番号 ←見出し行 2 H ←書出し列
(*1)仕入先一覧の各シートの合計行は以下の場所に入っています。
例えば、マクロのシートの書き込みする列を'H'と指定した場合、
H〜L列(5列分)の一番下と下から2番目の列が合計行になります。
・下から2番目の行：割合
・一番下の行 ：件数
(*2)合計のシートの書き込みたい列と仕入先一覧のシートのコピーしたい列は
同じ列になります。
例えば、マクロのシートの書き込みする列を'H'と指定した場合、
合計のシートの書き込みたい列、仕入先一覧のシートのコピーしたい列
どちらもH〜L列(5列分)になります。
●合計シート
1〜6行目は見出し行です。
A列 B列 C列 D列 E列 F列 ・・ 7行目 8行目 1 X 仕入先1111A 9行目 10行目 2 X 仕入先2222A 11行目 12行目 3 X 仕入先3333A
※合計シートを基点にB列に入っている数字分、
右隣りにあるシートをから合計欄を取得したいです。
例えばB列が"1"の場合、1つ右隣のシートから、
"2"の場合は2つ右隣のシートから合計行を取得するメージです。
●仕入先一覧シート右隣1つ目(仕入先一覧(A社)(合計行))
マクロのシートの書き込みする列を'H'と指定した場合
H列 I列 J列 K列 L列・・
下から2番目の行： 10% 20% 25% 30% 15%
一番下の行 ： 50 100 125 150 75
●仕入先一覧シート右隣2つ目(仕入先一覧(B社)合計行))
マクロのシートの書き込みする列を'H'と指定した場合
H列 I列 J列 K列 L列・・
下から2番目の行： 15% 30% 20% 25% 10%
一番下の行 ： 60 120 80 100 40
●仕入先一覧シート右隣3つ目(仕入先一覧(C社)合計行))
マクロのシートの書き込みする列を'H'と指定した場合
H列 I列 J列 K列 L列・・
下から2番目の行： 30% 10% 40% 8% 12%
一番下の行 ： 180 60 240 48 72
●マクロ実行後の合計シート
A列 B列 C列 D列 ・・ H列 I列 J列 K列 L列・・ 7行目 10% 20% 25% 30% 15% 8行目 1 X 仕入先1111A 50 100 125 150 75 9行目 15% 30% 20% 25% 10% 10行目 2 X 仕入先2222A 60 120 80 100 40 11行目 30% 10% 40% 8% 12% 12行目 3 X 仕入先3333A 180 60 240 48 72 ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ：
自分で作ってみようと思って試してみたのですが、
隣やその隣のシートを参照して、合計の項目を取得するところがよくわからない状態で
マクロを書いてもらえたらそこから勉強してみようと思っています。
(厚かましいお願いですみません・・。)
上手く伝わらない箇所などありましたら、また追加で書きますので、
たびたびですみませんが、どうぞよろしくお願い致します。
（みかん） 2017/09/21(木) 16:21
Public Sub picUpTwoTTLs() '合計値転記
Const ColsToProc As Long = 5 '処理すべき列数を定数にして置く (データ列数)
Dim ws合計 As Worksheet
Dim RW As Long, ColPointed
Dim ShtNextRng As Range
Dim offsetNum
Set ws合計 = Workbooks("仕入先一覧.xlsx").Sheets("合計")
Rem 指定された列番号をメモる(コピー元=貼付け先。例:H)
ColPointed = ThisWorkbook.Sheets("Sheet1").Range("B2").Value
Set ShtNextRng = ws合計.Range("B8", ws合計.Cells(ws合計.Rows.Count, "B").End(xlUp))
For RW = 1 To ShtNextRng.Rows.Count Step 2
offsetNum = ShtNextRng(RW, 1).Value '幾つ右隣か
If IsNumeric(offsetNum) And Not IsEmpty(offsetNum) Then
With Workbooks("仕入先一覧.xlsx").Sheets(offsetNum + 1) '右隣りのシート上
.Cells(.Rows.Count, ColPointed).End(xlUp).Offset(-1).Resize(2, ColsToProc).Copy _
ShtNextRng(RW - 1, 1).EntireRow.Cells(1, ColPointed) '貼付け先の先頭セル
End With
End If
Next RW
End Sub
（半平太） 2017/09/21(木) 21:55
ありがとうございます。
今、試してみたら、思い通りの結果になっています。
明日会社で使用しているファイルで試してみます。
作って頂いたマクロも理解して行きたいと思いますので
また質問すると思いますが、どうぞよろしくお願い致します。
本当にいつもありがとうございます。
感謝しています。
（みかん） 2017/09/21(木) 22:38
おはようございます。
昨日作って頂いたマクロを試してみたのですが、
仕入先一覧の合計欄には式が入っていて
今は式をコピーしているようで表示が「#REF!」と
なってしまうんです。
貼り付けを「値貼り付け」にしてみたいです。
調べて自分でやってみたのですが、上手くできずエラーになってしまいました。
●修正した内容
「PasteSpecial Paste:=xlPasteValues」を付ければいいのかな？と思って
最後に追加したのですが「コンパイルエラー：構文エラー」になってしまいました。
With Workbooks("■【東海&北陸地区1】提出資料1709(合計テスト).xlsx").Sheets(offsetNum + 1) '右隣りのシート上
.Cells(.Rows.Count, ColPointed).End(xlUp).Offset(-1).Resize(2, ColsToProc).Copy _
ShtNextRng(RW - 1, 1).EntireRow.Cells(1, ColPointed).PasteSpecial Paste:=xlPasteValues '貼付け先の先頭セル
すみませんが、どうぞよろしくお願い致します。
（みかん） 2017/09/22(金) 09:22
Copyメソッドには、貼付けの型を指定するオプションはありません。
なので、一旦クリップボードにコピーしてから、PasteSpecial メソッドで指定してください。
＞ With Workbooks("仕入先一覧.xlsx").Sheets(offsetNum + 1) '右隣りのシート上
＞ .Cells(.Rows.Count, ColPointed).End(xlUp).Offset(-1).Resize(2, ColsToProc).Copy _
＞ ShtNextRng(RW - 1, 1).EntireRow.Cells(1, ColPointed) '貼付け先の先頭セル
＞ End With
↓変更
With Workbooks("仕入先一覧.xlsx").Sheets(offsetNum + 1) '右隣りのシート上
.Cells(.Rows.Count, ColPointed).End(xlUp).Offset(-1).Resize(2, ColsToProc).Copy
End With
ShtNextRng(RW - 1, 1).EntireRow.Cells(1, ColPointed).PasteSpecial _
Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, Transpose:=False
（半平太） 2017/09/22(金) 10:04
変更後のマクロで動かすとうまくできました！
ありがとうございました。
時間のある時にマクロの内容を理解して行きたいので
どうぞよろしくお願い致します。
（みかん） 2017/09/22(金) 10:28
お世話になります。
先日教えて頂いたマクロ、自分なりで理解したつもりで
新たにやりたいことができたので、
最初に作ってもらったマクロと合計シートを作るマクロを組み合わて(？)
自分で作ってみたのですが、全く上手く動かずです・・。
後で私の考えたマクロを載せようと思うのですが、
私の作ったマクロは全く無視して、
新しく作ってもらっても全然いい(むしろそっちの方がいい)ので
よろしくお願い致します。
以下がやりたいことです。
合計のシートをもう1枚作りたいです。
マクロは、この前に作った合計を取得するマクロと合体して1つのマクロにできそうでしたら、
1つの方がいいです。(2つになってもいいです。)
マクロのシートで記入している書出し列は、どちらの合計のシートも同じ列です。
●シートの並び
1シート目：合計シート1 ←前回作成分
2シート目：合計シート2 ←今回作成したいシート
3シート目：仕入先一覧(A社)
4シート目：仕入先一覧(B社)
5シート目：仕入先一覧(C社)
： ： ：
仕入先一覧の各シート(今のマクロで作成しているシート)の明細行から特定の行の値を
合計のシートに値貼り付けしたいです。
書き込みする列をマクロのシートで指定するのは同じ方法でと思っています。(*1)
行 ______A______ _B_ 1 書出し列番号 ←見出し行 2 H ←書出し列
(*1)合計のシートの書き込みたい列と仕入先一覧のシートのコピーしたい列は
同じ列になります。
例えば、マクロのシートの書き込みする列を'H'と指定した場合、 合計のシートの書き込みたい列、仕入先一覧のシートのコピーしたい列 どちらもH〜L列(5列分)になります。
●合計シート2
1〜6行目は見出し行です。
A列 B列 C列 D列 E列 F列 ・・ 7行目 1 1111A 8行目 1 X 仕入先1111A 9行目 2 2222A 10行目 2 X 仕入先2222A 11行目 3 3333A 12行目 3 X 仕入先3333A
※合計シートを基点にB列に入っている数字分、右隣りにあるシート(仕入先一覧)から、
D列の値をキーに仕入先一覧のD列に同じ値が入っている行から値を取得したいです。
例えばB列が"1"の場合、1つ右隣のシートから、
"2"の場合は2つ右隣のシートから値を取得するメージです。
●仕入先一覧シート右隣1つ目(仕入先一覧(A社))
1〜6行目は見出し行です。
マクロのシートの書き込みする列を'H'と指定した場合
A列 B列 C列 D列 ・・ H列 I列 J列 K列 L列・・ 7行目 1111A 10% 20% 25% 30% 15% 8行目 * X 仕入先1111A 50 100 125 150 75
●仕入先一覧シート右隣2つ目(仕入先一覧(B社))
1〜6行目は見出し行です。
マクロのシートの書き込みする列を'H'と指定した場合
A列 B列 C列 D列 ・・ H列 I列 J列 K列 L列・・ 95行目 2222A 15% 30% 20% 25% 10% 96行目 * X 仕入先2222A 60 120 80 100 40
●仕入先一覧シート右隣3つ目(仕入先一覧(C社)))
1〜6行目は見出し行です。
マクロのシートの書き込みする列を'H'と指定した場合
A列 B列 C列 D列 ・・ H列 I列 J列 K列 L列・・ 13行目 3333A 30% 10% 40% 8% 12% 14行目 * X 仕入先3333A 180 60 240 48 72
※何行目か書きましたが、何行目かは関係なく、D列の値が一致する行から
値を取得したいです。
●マクロ実行後の合計シート
A列 B列 C列 D列 ・・ H列 I列 J列 K列 L列・・ 7行目 1 1111A 10% 20% 25% 30% 15% 8行目 1 X 仕入先1111A 50 100 125 150 75 9行目 2 2222A 15% 30% 20% 25% 10% 10行目 2 X 仕入先2222A 60 120 80 100 40 11行目 3 3333A 30% 10% 40% 8% 12% 12行目 3 X 仕入先3333A 180 60 240 48 72 ： ： ： ： ： ： ： ： ： ： ： ： ： ： ： ：
ねんのため・・、以下私の作った動きがおかしいマクロです。
うまく動かないけど、ここまで自力で作りました・・、と言った感じです。
=============================================================================
Sub InfoUpdate() '合計値転記
Const ColsToProc As Long = 5 '処理すべき列数を定数にして置く (データ列数)
Dim ws合計 As Worksheet
Dim ws明細 As Worksheet
Dim RW As Long, ColPointed
Dim rngMeisai As Range
Dim rngTotal As Range
Dim cel As Range
Dim offsetNum
Dim AddressToFil As String, custCode
Set ws合計 = Workbooks("仕入先一覧_2.xlsx").Sheets("合計")
Set rngTotal = ws合計.Range("B7", ws合計.Cells(ws合計.Rows.Count, "B").End(xlUp))
Rem 指定された列番号をメモる(コピー元=貼付け先。例:H)
ColPointed = ThisWorkbook.Sheets("Sheet1").Range("B2").Value
Rem 埋込先の列の1行目のアドレスを把握する (貼り付け位置)
AddressToFil = Range(ThisWorkbook.Sheets("Sheet1").Range("B2").Value & 1).Resize(1, ColsToProc).Address(0, 0)
For Each cel In rngTotal.Columns(1).Cells
offsetNum = rngTotal(cel.Row, 1).Value '幾つ右隣か
Set ws明細 = Workbooks("仕入先一覧_2.xlsx").Sheets(offsetNum + 1) '右隣りのシート上
Set rngMeisai = ws明細.Range("D7", ws明細.Cells(ws明細.Rows.Count, "D").End(xlUp))
If IsNumeric(cel.Value) And Not IsEmpty(cel.Value) Then
custCode = cel.Offset(0, 2).Value
RW = Application.Match(custCode, rngMeisai.Columns("A"), 0) '該当位置を取得
End If
If IsNumeric(RW) Then
cel.EntireRow.Range(AddressToFil).Value = rngMeisai.Cells(RW, 2).Resize(1, ColsToProc).Value
Else
cel.EntireRow.Range(AddressToFil).Value = 0
End If
Next
MsgBox "完了"
End Sub
=============================================================================
ちなみに、動かすと合計シートのマクロのシートで指定した列から5列分、1行目から7行目が、
ヘッダ部分を思われる部分からデータを取得して来てもともとあった値が消えてしまいます・・。
まだまだ理解できてないことがいっぱいです。
処理を少し付け加えるとかは何とかできるようになって来ましたが、
最初から作るのは全く勉強不足な感じです。
どうぞよろしくお願い致します。
（みかん） 2017/10/03(火) 16:31
For Each Next ループを使うと、セルをひとつずつチェックするので 無駄な様な気がしますけれども(※)、まぁ、そのまま使うとすると下記になります。
※2行ずつ処理できるハズなので、そうすれば書込み回数は半分に減ります。
Sub InfoUpdateForTTL2() '合計2 値転記
Const ColsToProc As Long = 5 '処理すべき列数を定数にして置く (データ列数)
Dim ws合計2 As Worksheet
Dim ws明細 As Worksheet
Dim RW As Long, ColPointed
Dim rngMeisai As Range
Dim rngTotal As Range
Dim cel As Range
Dim offsetNum
Dim AddressToFil As String, custCode
Set ws合計2 = Workbooks("仕入先一覧.xlsx").Sheets("合計2")
Set rngTotal = ws合計2.Range("B7", ws合計2.Cells(ws合計2.Rows.Count, "B").End(xlUp))
Rem 指定された列番号をメモる(コピー元=貼付け先。例:H)
ColPointed = ThisWorkbook.Sheets("Sheet1").Range("B2").Value
Rem 埋込先の列の1行目のアドレスを把握する (貼り付け位置)
AddressToFil = Range(ThisWorkbook.Sheets("Sheet1").Range("B2").Value & 1).Resize(1, ColsToProc).Address(0, 0)
Application.ScreenUpdating = False
For Each cel In rngTotal.Columns(1).Cells
offsetNum = cel.Value + 1 '幾つ右隣か・・・自シートが2番目なので「1」を強制加算
Set ws明細 = Workbooks("仕入先一覧.xlsx").Sheets(offsetNum + 1) '右隣りのシート上
Set rngMeisai = ws明細.Range("D7", ws明細.Cells(ws明細.Rows.Count, "D").End(xlUp))
If IsNumeric(cel.Value) And Not IsEmpty(cel.Value) Then
custCode = cel.Offset(0, 2).Value
RW = Application.Match(custCode, rngMeisai.Columns("A"), 0) '該当位置を取得
End If
If IsNumeric(RW) Then
rngMeisai.Cells(RW, 2).EntireRow.Range(AddressToFil).Copy
cel.EntireRow.Range(AddressToFil).PasteSpecial _
Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, Transpose:=False
Else
cel.EntireRow.Range(AddressToFil).Value = 0
End If
Next
Application.ScreenUpdating = True
MsgBox "完了"
End Sub
（半平太） 2017/10/03(火) 21:15
早速の返信、本当にありがとうございます。
今、テストデータで動かしてみたら、思った通りの結果になりました！
明日、本当のデータで確認してみます。
自分で作ったマクロと半平太さんが作ってくれたマクロを比較して
上手くいかなかった理由なども確認してみようと思います。
本当にいつもありがとうございます。
※2行ずつ処理できるハズなので、そうすれば書込み回数は半分に減ります。
2行で1データのようになっているので、半平太さんが言われているとおり
名前かコードどちらかで一致するデータを2行取って来ることで
書き込み回数は半分になります。
最初のマクロの「仕入先情報.xlsx」からデータを取得する
ところが1行だったので、そこを使おうと思って、1行ずつにしたんです。
今回のもあまりデータ数が多くないので、大丈夫と思います。
丁寧にコメント頂き、ありがとうございます！
またマクロを確認する時に質問すると思いますが、
どうぞよろしくお願い致します。
（みかん） 2017/10/03(火) 23:06
今日、本当のデータで試してみたところ、
一部うまく動かないところがありまして、
私の合計シートの書き方がよくなかったんだと思います。
●合計シート2
1〜6行目は見出し行です。
A列 B列 C列 D列 E列 F列 ・・ 7行目 1 1111A 8行目 1 X 仕入先1111A ： : : : ： : : : 11行目 2 2222A 12行目 2 X 仕入先2222A ： : : : ： : : : 17行目 3 3333A 18行目 3 X 仕入先3333A ： : : :
B列の参照するシートの数が変わるタイミングで合計やヘッダのようなものが入っていて
そこは値をセットしたくないんです。
たぶんなのですが、今処理しているマクロでは「RW」の内容が残っているので
合計やヘッダの行にも前と同じ値が入ってしまうようなんです。
自分でForのループの直後に「RW」にをクリアしたりしてみたのですが、
うまく動かないので、すみませんがよろしくお願いします。
もしかしたら、上記は私の推測で実は違うのかもしれないです・・。
たびたびすみません。
どうぞよろしくお願い致します。
（みかん） 2017/10/04(水) 14:56
＞B列の参照するシートの数が変わるタイミングで合計やヘッダのようなものが入っていて ＞そこは値をセットしたくないんです。
値をセットしたくない行なのかどうか、どこで(どこを見て）区別するんですか？
※そのヘッダーの行のＢ列には何が入っているんですか？
（半平太） 2017/10/04(水) 15:07
返信ありがとうございます。
上手く表現できていなくて、すみません。
合計2シートの合計やヘッダーの行のB列には何も入っていないんです。
(下のイメージです。B列が空白になります。)
値をセットしたくない行なのかどうかは、B列に数字が入っていたらセットする、というようにしたいです。
(もしも数字以外があった場合は MsgBox でメッセージを表示して、処理中止にしたいです。)
●合計シート2
1〜6行目は見出し行です。
A列 B列 C列 D列 E列 F列 ・・ 7行目 1 1111A 8行目 1 X 仕入先1111A 合計 空白 : : : ヘッダー 空白 : : : 11行目 2 2222A 12行目 2 X 仕入先2222A 合計 空白 : : : ヘッダー 空白 : : : 17行目 3 3333A 18行目 3 X 仕入先3333A 合計 空白 : : : ヘッダー 空白 : : :
どうぞよろしくお願い致します。
（みかん） 2017/10/04(水) 16:11
Sub InfoUpdateForTTL2() '合計2 値転記
Const ColsToProc As Long = 5 '処理すべき列数を定数にして置く (データ列数)
Dim ws合計2 As Worksheet
Dim ws明細 As Worksheet
Dim RW As Long, ColPointed
Dim rngMeisai As Range
Dim rngTotal As Range
Dim cel As Range
Dim offsetNum
Dim AddressToFil As String, custCode
Set ws合計2 = Workbooks("仕入先一覧.xlsx").Sheets("合計2")
Set rngTotal = ws合計2.Range("B7", ws合計2.Cells(ws合計2.Rows.Count, "B").End(xlUp))
Rem 指定された列番号をメモる(コピー元=貼付け先。例:H)
ColPointed = ThisWorkbook.Sheets("Sheet1").Range("B2").Value
Rem 埋込先の列の1行目のアドレスを把握する (貼り付け位置)
AddressToFil = Range(ThisWorkbook.Sheets("Sheet1").Range("B2").Value & 1).Resize(1, ColsToProc).Address(0, 0)
Application.ScreenUpdating = False
For Each cel In rngTotal.Columns(1).Cells
If Not IsEmpty(cel) Then '空白は無視
If IsNumeric(cel) Then '数値のみ処理
offsetNum = cel.Value + 1 '幾つ右隣か・・・自シートが2番目なので「1」を強制加算
Set ws明細 = Workbooks("仕入先一覧.xlsx").Sheets(offsetNum + 1) '右隣りのシート上
Set rngMeisai = ws明細.Range("D7", ws明細.Cells(ws明細.Rows.Count, "D").End(xlUp))
If IsNumeric(cel.Value) And Not IsEmpty(cel.Value) Then
custCode = cel.Offset(0, 2).Value
RW = Application.Match(custCode, rngMeisai.Columns("A"), 0) '該当位置を取得
End If
If IsNumeric(RW) Then
rngMeisai.Cells(RW, 2).EntireRow.Range(AddressToFil).Copy
cel.EntireRow.Range(AddressToFil).PasteSpecial _
Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, Transpose:=False
Else
cel.EntireRow.Range(AddressToFil).Value = 0
End If
Else
MsgBox cel.Address & "に「数値・空白」以外があり。処理中止"
Exit Sub
End If
End If
Next
Application.ScreenUpdating = True
MsgBox "完了"
End Sub
（半平太） 2017/10/04(水) 16:57
早速作って頂いて、本当にありがとうございます！
今、動かしてみたら、思い通りの結果になっていました。
取り急ぎ、ご連絡させていただきます。
明日以降でマクロの内容を理解して行こうと思いますので、
どうぞよろしくお願い致します。
（みかん） 2017/10/04(水) 17:30
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.