A列~N列迄データが入力されている発注表があります。
毎日、入荷現品と照合して、合致したら該当品のC列に日付を入力しています。
合致項目はD~H列の製品番号のいずれとK列の数量です。
製品番号は各行に1番号のみ入力されています。
ただ、それがD列だったり、F列だったりします。
A~N全てが空白の行もあります。
行数はシートによって一定ではありません。
毎日C列に日付が埋められていくわけですが、
例えば、空白セルが残り3個になったら 「残り3品目です」。2個だったら「残り2品目です」のように
残り1品目になるまで、C列に日付を入力すると
メッセージボックスで知らせてくれるようなことができましでしょうか?
また、残りが0品目。
すなわちデータが何も入っていない行を除いたC列全てに日付が入力されたら
データが入力されている最終セルまでの下線部に実線を入れ(A~N)、
印刷日をN1セルに入力、
A~Nが全て収まり横向きで印刷をすることも出来ますでしょうか?
行方向は分割されて構いません。
その時、I列以外は列幅13で、I列のみAutofitで文字幅に合わせるようにしたいです。
No.2ベストアンサー
- 回答日時:
こんにちは。
>セル幅や縮小、横向きなどは自動で行われ印刷されるようにしたいです。
最後の印刷ついては、次回にしてください。
変更したコードは、下に書いておきます。'* が変更部分です。
本来は、コードをそのまま残して修正部分を書きたかったのですが、一部で、End With の位置を変えたり、変数を加えたりしたので、「Sub 検索()」は、全文を書き出しました。また、ユーザー定義関数の「DoubleCountBlank()」を作りました。「Sub 検索()」は、入れ替え、「DoubleCountBlank()」は、貼り付けてください。
>c.Activate '←出来ればEFGHのいずれかに入力されているデータをアクティブしたい。1行に対して>EFGH列のいずれにだけSheet1のA1に対する検索データが入っている
その部分は、
c.End(xlToRight).Activate 'Offset(0, 3).Activate '*
こんな風にカーソルを飛ばしてみたらいかがでしょうか。そうでないなら、Office(0,3)にしてください。
> Ws2.Select '←Ws2を表示させたいのですがselectを使わない方法を教えてください
Application.Goto Ws2.Range("A1"), True
という書き方があります。指定セルまで飛びます。第2パラメーターの 「True」は、その指定した場所に、例えば、"Z100"などになると、その指定した場所が左上端になります。"A1"では、あまり変わりませんが。
今回は、オブジェクトの開放はしていませんが、ローカル・マクロが終了すれば、オブジェクトは開放されてしまいます。今後の展開を考え、それは入れないでおきます。
'//
Sub 検索()
'Ver. 0.3 --2014.04.23
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim strKey As Variant
Dim s As String
Dim c As Range, bln As Boolean
Dim rng1 As Range '*
Dim cnt As Long '*
Set Ws1 = Sheet1
Set Ws2 = Sheet2
Ws1.Select
With Ws2
strKey = Application.Transpose(.Range("A1").Resize(2).Value)
strKey = Join(strKey, "")
End With
If Trim(strKey) = "" Then MsgBox "検索キーが空です", vbCritical: Exit Sub
With Ws1
Set rng1 = .Range("K2", .Cells(Rows.Count, "K").End(xlUp)) '*
For Each c In rng1.Offset(, -10)
'E,F,G,H を検索
s = c.Offset(0, 4).Value & c.Offset(0, 5).Value & c.Offset(0, 6).Value & c.Offset(0, 7).Value & c.Offset(0, 10).Value
If StrComp(s, strKey, vbTextCompare) = 0 And c.Offset(0, 2).Value = "" Then '変更を加えた
c.Offset(0, 2).Value = Date
c.End(xlToRight).Activate 'Offset(0, 3).Activate '*
c.Resize(1, 14).Interior.ColorIndex = 6
bln = True
Exit For
End If
Next c
If Not bln Then
Ws2.Select
MsgBox "リストに存在しません", vbExclamation, "NotFound"
Else '加える
Call ReSearch(Ws1.Range("M2"), c.Row)
'再設定
Set rng1 = .Range("K6", .Cells(Rows.Count, "K").End(xlUp))
MsgBox "残り" & DoubleCountBlank(rng1.Offset(, -8), rng1) & "品目です。", vbInformation '* ユーザー定義関数へ
End If
End With
Application.Goto Ws2.Range("A1"), True '*
End Sub
'//ユーザー定義関数
Function DoubleCountBlank(rng1 As Range, rng2 As Range)
'横並びのセルのブランクをカウントする (セル範囲1 , セル範囲2)
Dim i As Long
Dim cnt As Long
For i = 1 To rng1.Rows.Count
If VarType(rng2.Cells(i, 1)) = vbDouble Then
If rng1.Cells(i, 1).Value = "" And rng2.Cells(i, 1).Value <> 0 Then
cnt = cnt + 1
End If
End If
Next i
DoubleCountBlank = cnt
End Function
'//
だいぶ、全貌が分かってきました。
今、手をつけるとグチャグチャになってしまいますが、この先、maron1010さんご自身で、コードの内容を、整理し直したほうがよいでしょうね。私が書いたものを含めて、継ぎ足し状態で、他人のコードの寄せ集めは、管理しづらいものです。アイデアだけを採用して、組み直した方がよいかもしれません。
なお、StrComp(s, strKey, vbTextCompare) = 0 と変更を加えたのは、私のマクロを書くスタイルです。文字列比較する時、Excel VBAは、あまり柔軟に対応しません。小文字・大文字などは、本来、考慮に入れませんので、TextCompare(テキスト比較)にしました。他にも、IntStr関数なども良いと思います。
ただ、あまりPCに慣れていない人は、思わぬ使い方をしますので、十二分に、エラー対策はしたほうがよいですね。そこで、私は、起動時にバックアップを取るマクロなどを考えだしました。
この回答への補足
いつもありがとうございます。
実は、、、と言うかお察ししているかと思いますが、
私はコードの内容は全くと言っていい程分からないのです。
ご教示していただいたものを、あれこれアレンジする技量も知識もないため
憤りを感じるかと思いますがご了承ください。
ご教示頂いたコードで動作確認致しました。
毎度の事乍ら、私の稚拙な文章から的を射たコードを提示して頂き、喜びと驚きです。
ただ・・・誠に申し訳なく言いにくいのですが、一つ別な問題が発覚しました。
再び稚拙な文章世界へお付き合いください。
たぶんサブルーチン辺りを変えると思うのですが・・・
まず、Ws2のA1セルが'E,F,G,H を検索 を D列も含め
'D,E,F,G,H を検索してD,E,F,G,H に検索対象があった時
Dだったらそのまま上に何か入力されているセルを検索、
また、E,F,G,Hのいずれかだったら左横列の上に向かって
(EならD 、FならE ・・・という具合に)
何か入力されているセルのM列の191000####をmsgboxで表示させたいです。
但し、検索結果がD列のデータだった時、その行のM列が191000####以外だった場合
M列の一番上から検索してヒットした191000#### &「これは例外です」を
msgboxで表示させたいです。
基本的にD列にデータがある場合のM列は191000####ですが
稀に191000####以外がある為です。
もう暫く我が儘聞いて頂けますでしょうか?
宜しくお願い致します。
一度、こちらの質問を閉じさせていただきます。
補足質問については新たに投稿いたしますので、そちらで宜しくお願い致します。
色々とありがとうございました。
No.1
- 回答日時:
こんにちは。
>残り1品目になるまで、C列に日付を入力すると
入力といっても、今までの流れからすると、日付を入れること自体が、マクロでは……?
それはどちらでもよいことですが、一応、単独の質問として、捉えれば、イベントになるはずです。
しかし、
>毎日C列に日付が埋められていくわけですが、
>空白セルが残り3個になったら 「残り3品目です」。2個だったら「残り2品目です」のように残り1品目になるまで、
質問文の中で、何に対して、空白セルが何個かというものが、良く分からないですね。そもそも、図自体の意味が、こちらは分かりません。
空白セルが何個か数えるのは、CountBlank であっても、C列に対してですか?しかし、C列には、日付ではない記号を入れている行もあります。そうすると、日付を入れた行のA列~N列までを対象にするようにも思えます。
状況説明も良いのですが、プログラム的というか、数学的に書かれていないと、答えが出来ないのです。
その次の
>その時、I列以外は列幅13で、I列のみAutofitで文字幅に合わせるようにしたいです。
Sub ArrangeCellWidth()
With Columns("A:H")
.Cells.Columns.ColumnWidth = 13
End With
Columns("I").AutoFit
End Sub
>A~Nが全て収まり横向きで印刷をすることも出来ますでしょうか?
Excel 2010 でしたら、ページレイアウト・モードにして、全体の縮小を掛けるなどすればよいと思います。マクロにするべきかどうか、迷うところです。それは、常に大きさの変化するシートならともかく、ふつうは、レイアウトが1つに決まれば、変えることはないような気がします。
この回答への補足
毎度乍らの語弊だらけで稚拙な文章、誠に申し訳ありません。
一応、今までの流れを踏襲してはいるものの、
列の並び等が今回独自のものになっていますので、ご了承ください。
実際に使用しているコードを下に置きました。
>残り1品目になるまで、C列に日付を入力すると
マクロを使ってC列に日付が入力されると・・・
>毎日C列に日付が埋められていくわけですが、
>空白セルが残り3個になったら 「残り3品目です」。2個だったら「残り2品目です」のように残り1品目になるまで
C列には日付以外も含まれています。
C列の空白セルをカウントするのは6行目から。
K列に数量がある行のC列に、マクロを使って日付が入ります。
K列に数量があって且つC列のセルが空白の時、残り3個になったらmsgboxで「残り3品目です」。・・・(略)
K列が空白でC列も空白の時はC列は空白残数としてカウントしない。
前回msgboxで "これは1100XXXXXXのグループです"を表示するように独自でやりました。
そこで、その後にmsgboxで「残り3品目です」を表示させたいです。
因みに実際に使用しているコードは以下のとおりです。
Sheet1(シート名は常に変わる)に
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address <> "$A$3" Then Exit Sub
Call 検索
Range("A1:A2").Clear
Range("A1").Activate
End Sub
Sub 検索()
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim strKey As Variant
Dim s As String
Dim c As Range, bln As Boolean
Set Ws1 = Sheet1
Set Ws2 = Sheet2
Ws1.Select
With Ws2
strKey = Application.Transpose(.Range("A1").Resize(2).Value)
strKey = Join(strKey, "")
End With
If Trim(strKey) = "" Then MsgBox "検索キーが空です", vbCritical: Exit Sub
With Ws1
For Each c In .Range("K2", .Cells(Rows.Count, "K").End(xlUp)).Offset(, -10)
'E,F,G,H を検索
s = c.Offset(0, 4).Value & c.Offset(0, 5).Value & c.Offset(0, 6).Value & c.Offset(0, 7).Value & c.Offset(0, 10).Value
If s = strKey And c.Offset(0, 2).Value = "" Then
c.Offset(0, 2).Value = Date
c.Activate '←出来ればEFGHのいずれかに入力されているデータをアクティブしたい。1行に対してEFGH列のいずれにだけSheet1のA1に対する検索データが入っている
c.Resize(1, 14).Interior.ColorIndex = 6
bln = True
Exit For
End If
Next c
End With
If Not bln Then
Ws2.Select
MsgBox "リストに存在しません", vbExclamation, "NotFound"
Else '加える
Call ReSearch(Ws1.Range("M2"), c.Row) '加える
End If
Ws2.Select '←Ws2を表示させたいのですがselectを使わない方法を教えてください
End Sub
'//サブルーチン
Sub ReSearch(Rng As Range, j As Long)
'最初のセル, 終わりの行数
Dim i As Long
Dim Ws As Worksheet
With Rng.Parent 'イレギュラーな書き方で、Rangeからシートオブジェクトを出しました。
For i = j To Rng.Row Step -1 '上に戻っていきます。
If CStr(.Cells(i, Rng.Column).Value) Like "1100######" Then '文字列比較
'.Cells(i, Rng.Column).Offset(, 2).Value
MsgBox "これは" & CStr(.Cells(i, Rng.Column).Value) &"のグループです"
Exit For '見つけたら離脱
End If
Next i
End With
End Sub
印刷については、シート上にボタンを配して、ボタンをクリックすると
(パソコンに疎い方にも使えるように)セル幅や縮小、横向きなどは自動で行われ印刷されるようにしたいです。
宜しくお願い致します。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) 【条件付き書式】countifsで複数条件を満たしたセルを赤くする方法 2 2023/02/09 23:53
- Excel(エクセル) エクセルで30日以内に同内容の入力があったら色を付ける 2 2023/03/04 12:32
- Visual Basic(VBA) 【VBA】データを入力後に,同一シート内に履歴として転記するVBAコードを教えていただきたいです。 3 2022/11/16 01:37
- Excel(エクセル) excelにおける転記マクロの書き方 2 2023/05/12 03:16
- Visual Basic(VBA) VBA 検索と入力 Excel ブック ぶぶぶ シート ししし 列V 検索対象の列です 最終行は、お 6 2023/05/17 01:40
- Visual Basic(VBA) 3つのプロシージャをまとめたら実行時エラー発生で対応不能 6 2022/05/17 01:47
- Excel(エクセル) SUMIFのIF分岐について 4 2023/04/15 12:57
- Visual Basic(VBA) エクセルVBAで『A列』に新規で数値を入力し『B列』から右方向の空白セルにその値を貼り付ける方法 4 2022/11/05 08:37
- Excel(エクセル) excelで検索した商品の画像(ネットワーク上の)を表示させたい。 3 2023/06/28 00:32
- Excel(エクセル) 日付で矢印マクロ 4 2023/07/25 16:47
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルVBA Unionはなぜ遅い?
-
エクセル 指定した文字列を含...
-
Excelで自動的に並べ替えなんて...
-
EXCELである列を上から順にチェ...
-
桁数が混在する並び替えの方法
-
エクセル VLOOKUPが反映されない
-
テキストボックス内の文字のふ...
-
Excelで数値→文字列変換で指数...
-
エクセルでグラフタイトルが折...
-
エクセルにおける、グラフの指...
-
エクセルグラフの一括設定。
-
塗りつぶしの色をコピーするには
-
エクセル
-
Excelの関数について、特定の文...
-
日付が1年以内になると他のセル...
-
エクセルのグラフの一部拡大
-
WORDのグレー括弧って?
-
Excelで行ごとコピー、同じ行を...
-
Excel 3列毎のセルを別の表に抽...
-
エクセル 入力中に表示されな...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセル 指定した文字列を含...
-
エクセルで同じ名前ごとの合計...
-
エクセルの関数SUBSTITUTEを、...
-
エクセルVBA Unionはなぜ遅い?
-
桁数が混在する並び替えの方法
-
エクセルで一部除外した数字を...
-
EXCEL VBA 指定範囲内で特定の...
-
エクセルで列内の同じIDの商品...
-
ExcelVBA:列方向の並び替え O...
-
オートフィルについて(急ぎ!)
-
エクセルで2列を検索し2列とも...
-
エクセル VLOOKUPが反映されない
-
エクセル マクロで列を連続し...
-
エクセルvba 一つ上の行を指定...
-
エクセルに詳しい人!!!至急...
-
エクセル 2010 マクロ 残セル表...
-
Excelで自動的に並べ替えなんて...
-
パソコンで簡易検索を作るには
-
EXCEL 指定した曜日に番号を振...
-
エクセル【昇順・降順で並べ替...
おすすめ情報