[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『1つのボタンに2種類のﾏｸﾛを登録させたい』（りんご）
いつも勉強させて頂いております。 先日、こちらでﾏｸﾛについて教えて頂き、有効活用しようと 日々頑張っています。
そこで質問なのですが、1つのﾎﾞﾀﾝ(四角形のｵﾌﾞｼﾞｪｸﾄにﾏｸﾛを登録しました)に 2種類以上のﾏｸﾛを登録する事は可能でしょうか？
詳しい作業の内容は･･･ Aｾﾙの値が0以上10未満の場合は、ｼｰﾄ1にこの作業を実行し、 Aｾﾙの値が11以上25未満の場合はｼｰﾄ2にこの作業を実行し、 Aｾﾙの値が26以上の場合はｼｰﾄ3に実行してほしい。 という感じです。
実行したい作業自体のﾏｸﾛは作成できますが、上記のように実行ｼｰﾄを分ける方法が わかりません。
皆様のお知恵をご教授頂きたいです。宜しくお願い致します。
例えば1つのﾎﾞﾀﾝに以下の様な範囲を判断するマクロ macro を割り当てる と実現可能です。
sub macro()
if Aｾﾙの値が0以上10未満 then
ｼｰﾄ1にこの作業を実行のマクロ呼び出し
else if Aｾﾙの値が11以上25未満 then
ｼｰﾄ2にこの作業を実行のマクロ呼び出し
else if Aｾﾙの値が26以上 then
ｼｰﾄ3にこの作業を実行のマクロ呼び出し
else
msgbox "範囲が対象外"
end if
end sub
sub ｼｰﾄ1にこの作業を実行のマクロ() 処理 end sub sub ｼｰﾄ2にこの作業を実行のマクロ() 処理 end sub sub ｼｰﾄ3にこの作業を実行のマクロ() 処理 end sub
(neptune)
下記の関連のご質問でしょうか。 [[20110213152724]]
マクロの記録を使うと簡単な処理はそのままできるようになります。 ですが、記録だけだと無駄なコードが多いですし、今回のように 記録した通りではなく、条件によって対象を変えたりというように やりたいことが出てきます。
そうなると、やはり記録した内容をそのままではなく、手を加える ことができるようになると応用範囲が広がります。
まずは、前回の記録したものを提示してはどうでしょうか。 今回のケースだと、フィルタで選択した数値によって、コピー先リスト を設定するという機能を追加することで、対応できるようになるかと 思います。 (Mook)
neptune様 ご回答ありがとうございます。
Mook様 おっしゃる通り、先日ご質問させて頂いた関係です。 下記が記録したﾏｸﾛです。
下記のﾏｸﾛにはAｾﾙの値を判断する記録はしていないのですが･･･。 「OP」ｼｰﾄにﾃﾞｰﾀの個数を表示させるｾﾙをA1に作成し、 その値によってｺﾋﾟｰ先のｼｰﾄを変更させたいのです。
Range("E3:H3").Select
Selection.Copy
Sheets("店長用").Select
Range("AM4:AP4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("OP").Select
Range("E4:K5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("店長用").Select
Range("E4:K5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("OP").Select
Range("Q4:X5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("店長用").Select
Range("G9:N10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("OP").Select
ActiveSheet.Range("$A$7:$AP$50").AutoFilter Field:=1, Criteria1:="<>"
ActiveWindow.SmallScroll Down:=-9
Range("B8:AO50").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("店長用").Select
Range("B16:M16").Select
ActiveSheet.Paste
Range("B16:M16").Select
Sheets("OP").Select
Range("B8:AN50").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("御客様用").Select
Range("B16:M16").Select
ActiveSheet.Paste
Range("B16:M16").Select
Sheets("OP").Select
Application.CutCopyMode = False
ActiveSheet.Range("$A$7:$AP$50").AutoFilter Field:=1
Range("B8:M8").Select
Sheets("店長用").Select
Range("E4:K5").Select
このﾏｸﾛの作業内容に A1ｾﾙの値=0以上10未満→店長用＆御客様用 A1ｾﾙの値=11以上25未満→店長用2＆御客様用2 A1ｾﾙの値=26以上→店長用3＆御客様用3（こちらの最大値はまだ未定です）
という条件によってｺﾋﾟｰ先のｼｰﾄを変更させたいです。 「OP」ｼｰﾄ作業内容は変更ありません。
以上、ご教授の程、宜しくお願い致します。
りんご
最初の部分を例にとって説明しますが、まずだいたい下記の操作を繰り返しています。
'1) -----------------------------
Range("E3:H3").Select
Selection.Copy
'2)-----------------------------
Sheets("店長用").Select
Range("AM4:AP4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'3)-----------------------------
Sheets("OP").Select
Range("E4:K5").Select
Application.CutCopyMode = False
Selection.Copy
'4)-----------------------------
Sheets("店長用").Select
Range("E4:K5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
まず、それを読めるようになるのが最初の一歩です。
(1)シートの選択
Sheets("シート名").Select
(2)範囲の選択
Range("セル範囲").Select
(3)選択範囲のコピー
Selection.Copy
(4)オートフィルタの実行(空白以外？)
ActiveSheet.Range("$A$7:$AP$50").AutoFilter Field:=1, Criteria1:="<>"
(5)形式を選択して貼り付け（値）
Selection.PasteSpecial Paste:=xlPasteValues
最初の1)にはシートの選択がありませんが、これはマクロ開始時にアクティブな シートで処理を行うためで
'1) -----------------------------
Sheets("OP").Select
Range("E3:H3").Select
Selection.Copy
であっても同じことです。
今回の目的のためには、A1の値に応じてシート名を変更することが必要ですが、
このような時に変数を導入します。
Sheets("店長用").Select
は
Dim CopySheetName As String '// 変数の宣言
CopySheetName = "店長用"
Sheets(CopySheetName).Select
としても同じ動きになります。
ですから今回はマクロの先頭で
Dim CopySheetNameMaster As String '// 変数の宣言
Dim CopySheetNameCustomer As String '// 変数の宣言
If Range("A1").Value >= 0 And Range("A1").Value < 10 Then
CopySheetNameMaster = "店長用"
CopySheetNameCustomer = "御客様用"
ElseIf Range("A1").Value >= 10 And Range("A1").Value < 25 Then
CopySheetNameMaster = "店長用2"
CopySheetNameCustomer = "御客様用2"
ElseIf Range("A1").Value >= 25 Then
CopySheetNameMaster = "店長用3"
CopySheetNameCustomer = "御客様用3"
End If
として、マクロ中の下記の部分を矢印の右側のように置き換えます。
Sheets("店長用") ⇒ Sheets(CopySheetNameMaster)
Sheets("御客様用") ⇒ Sheets(CopySheetNameCustomer)
ここまでで今回の目標は、達成できるかと思います。
ここから先は今後の応用ですが、マクロを実際に自分で書けるようになると、
いちいち選択しなくても処理を実行できるように、書くこともできます。
1)～4) の部分は
'1) -----------------------------
Sheets("OP").Range("E3:H3").Copy
'2)-----------------------------
Sheets("店長用").Range("AM4:AP4").PasteSpecial Paste:=xlPasteValues
'3)-----------------------------
Sheets("OP").Range("E4:K5").Copy
'4)-----------------------------
Sheets("店長用").Range("E4:K5").PasteSpecial Paste:=xlPasteValues
と書いても、まったく同じ処理結果になります。 しかもこの場合シート選択やセルの選択がない分、画面のちらつき（変更）がなく 処理も早く終わります。
今回の記録から不要な部分を削った結果は、
Sub CopyFilterResult()
Dim CopySheetNameMaster As String '// 変数の宣言
Dim CopySheetNameCustomer As String '// 変数の宣言
If Range("A1").Value >= 0 And Range("A1").Value < 10 Then
CopySheetNameMaster = "店長用"
CopySheetNameCustomer = "御客様用"
ElseIf Range("A1").Value >= 10 And Range("A1").Value < 25 Then
CopySheetNameMaster = "店長用2"
CopySheetNameCustomer = "御客様用2"
ElseIf Range("A1").Value >= 25 Then
CopySheetNameMaster = "店長用3"
CopySheetNameCustomer = "御客様用3"
End If
Sheets("OP").Range("E3:H3").Copy
Sheets(CopySheetNameMaster).Range("AM4:AP4").PasteSpecial Paste:=xlPasteValues
Sheets("OP").Range("E4:K5").Copy
Sheets(CopySheetNameMaster).Range("E4:K5").PasteSpecial Paste:=xlPasteValues
Sheets("OP").Range("Q4:X5").Copy
Sheets(CopySheetNameMaster).Range("G9:N10").PasteSpecial Paste:=xlPasteValues
Sheets("OP").Range("$A$7:$AP$50").AutoFilter Field:=1, Criteria1:="<>"
Sheets("OP").Range("B8:AO50").Copy
Sheets(CopySheetNameMaster).Range("B16:M16").Paste
Sheets("OP").Range("B8:AN50").Copy
Sheets(CopySheetNameCustomer).Range("B16:M16").Paste
Sheets("OP").Range("$A$7:$AP$50").AutoFilter Field:=1
Sheets(CopySheetNameMaster).Select
End Sub
とすることができます。
マクロの先頭にカーソルを置いて、F8 を押すと1ステップずつの実行確認ができますので、 マクロとEXCEL を並べて実行してみると、動作を理解しやすくなるかと思います。 最後に提示したものはシートの切り替えをしていないので、それぞれのシートを表示して 実行してみると違いが判るので、確認してみてください。 (Mook)
Mook様
度々のご教授ありがとうございます。 Mook様に教えて頂いた不要な部分を削ったﾏｸﾛを組んでみたのですが、
Sheets(CopySheetNameMaster).Range("B16:M16").Paste
の部分で「実行時ｴﾗｰ'438' ｵﾌﾞｼﾞｪｸﾄはこのﾌﾟﾛﾊﾟﾃｨまたはﾒｿｯﾄﾞをｻﾎﾟｰﾄしていません」という
ﾒｯｾｰｼﾞが出てしまいます。
何が原因か分からないので色々調べているのですが･･･。 またお知恵を貸して頂ければ幸いです。宜しくお願い致します。
りんご
A1 で指定した数値に対応するシートは存在するでしょうか。 数字の半角、全角が異なっていても当該のエラーになります。
エラーになったときに、変数上にカーソルを持っていくと 変数の内容が表示されますから、CopySheetNameMaster の中身が何になって いるか確認してみてください。
ですが、コピー元とコピー先の範囲が異なっていますので、
Sheets(CopySheetNameMaster).Range("B16").Paste
とした方が良いかもしれません。
ご確認下さい。
(Mook)
Mookさんお邪魔します。
PasteSpecialの対象オブジェクトはWorksheetかRangeですが Pasteメソッドの対象オブジェクトはWorksheetだけでRangeは無いのが原因ではないでしょうか？
Destinationを使う方が良さそうです。
With Sheets("OP")
.Range("$A$7:$AP$50").AutoFilter Field:=1, Criteria1:="<>"
.Range("B8:AO50").Copy Sheets(CopySheetNameMaster).Range("B16")
End With
（ｍｏｍｏ）
本当だ。単純に纏めただけのつもりが、記載の記述では動きませんね。 フォローありがとうございました。
後半は下記のようにしてください。
Sheets("OP").Range("B8:AO50").Copy Sheets(CopySheetNameMaster).Range("B16:M16")
Sheets("OP").Range("B8:AN50").Copy Sheets(CopySheetNameCustomer).Range("B16:M16")
もう一歩進めると、ｍｏｍｏさんが提示されているように、ベースとなる
オブジェクトを With 句で纏めるともっとスマートになります。
まだまだ、頭の中だけでは完璧なコードが書けませんonz。 (Mook)
Mook様 momo様 いつもお世話になっております。
ご連絡が遅くなってしまい、申し訳ありません。 ご教授頂いたおかげで希望通りの物ができそうです。
現在、教えていただいたﾏｸﾛで私の希望していた形になりましたが、 これから少しずつ手を加えていく予定です。 また何か分からない事がありましたら教えて下さい。 この度は本当にお世話になりました。
りんご
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.