[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『データの整理方法について』（Machi）
旧スレ『エクセルのオートフィルタをかけた可視セルを参照』
http://www.excel.studio-kazu.jp/kw/20130403114539.htmlから移動しました。
＞その際、現在出来ているコードは 新しいスレに入れる様にして貰えると良いのですが。
今できているのは、以下の４つになります。
①データ収集用コード
Private Const MainSh = "Sheet1"
Sub データ収集()
Dim i As Long
With Sheets(MainSh)
.Range("A1:J1").Value = _
Array("商品名", "出庫月", "部署", "出庫数", "金額", "使用量", "表示病棟名", "表示商品名", "元シート", "昇順") →昇順はここに入れました。
For i = 3 To Worksheets.Count
Sheets(i).Select
If Range("A1").Value = " [9]ＳＰＤ" Then
If Range("A5").Value <> "" Then
Call 様式1 '石鹸マクロ
End If
Else
If Range("B8").Value <> "" Then
Call 様式2 '消毒薬マクロ
End If
End If
Next
.Select
End With
End Sub
Sub 様式1()
Dim RCnt As Long, myR As Long
RCnt = Range("A" & Rows.Count).End(xlUp).Row - 4
With Sheets(MainSh)
myR = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & myR).Resize(RCnt).Value = Range("A2").Value '商品名
.Range("B" & myR).Resize(RCnt).Value = Range("D5").Resize(RCnt).Value '出庫月
.Range("C" & myR).Resize(RCnt).Value = Range("B5").Resize(RCnt).Value '部署
.Range("D" & myR).Resize(RCnt).Value = Range("G5").Resize(RCnt).Value '出庫数
.Range("E" & myR).Resize(RCnt).Value = Range("J5").Resize(RCnt).Value '金額
.Range("I" & myR).Resize(RCnt).Value = ActiveSheet.Name 'シート名
End With
End Sub
Sub 様式2()
Dim RCnt As Long, myR As Long
RCnt = Range("B" & Rows.Count).End(xlUp).Row - 7
With Sheets(MainSh)
myR = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & myR).Resize(RCnt).Value = Range("D6").Value '商品名
.Range("B" & myR).Resize(RCnt).Value = Range("C4").Value '出庫月
.Range("C" & myR).Resize(RCnt).Value = Range("B8").Resize(RCnt).Value '部署
.Range("D" & myR).Resize(RCnt).Value = Range("M8").Resize(RCnt).Value '出庫数
.Range("E" & myR).Resize(RCnt).Value = Range("P8").Resize(RCnt).Value '金額
.Range("I" & myR).Resize(RCnt).Value = ActiveSheet.Name 'シート名
End With
End Sub
②数式を入れるコード
Option Explicit
Private Const MainSh = "Sheet1"
Private Const 表Sh = "対応表"
Sub 数式を入れる4()
Dim mxR As Long
Dim 部署名 As Long, 物品 As Long
Dim 昇順 As Long
With Sheets(MainSh)
mxR = Range("C" & Rows.Count).End(xlUp).Row
.Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
.Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
部署名 = Sheets(表Sh).Range("H" & Rows.Count).End(xlUp).Row
.Range("G2:G" & mxR).Formula = _
"=IF(COUNTIF(" & 表Sh & "!$H$2:$H$" & 部署名 & ",C2),VLOOKUP(C2," & 表Sh & "!$H$2:$I$" & 部署名 & ",2,FALSE),""その他"")"
物品 = Sheets(表Sh).Range("A" & Rows.Count).End(xlUp).Row
.Range("F2:F" & mxR).Formula = _
"=IF(COUNTIF(" & 表Sh & "!$A$2:$A$" & 物品 & ",A2),D2*VLOOKUP(A2," & 表Sh & "!$A$2:$B$" & 物品 & ",2,FALSE),""？"")"
.Range("H2:H" & mxR).Formula = _
"=IF(COUNTIF(" & 表Sh & "!$A$2:$A$" & 物品 & ",A2),VLOOKUP(A2," & 表Sh & "!$A$2:$C$" & 物品 & ",3,FALSE),""？"")"
昇順 = Sheets(MainSh).Range("G" & Rows.Count).End(xlUp).Row
.Range("J2:J" & mxR).Formula = "=MATCH(G2," & 表Sh & "!$E$3:$E$23,0)"
End With
With Sheets(MainSh).Sort
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
.SortFields.Add Key:=.Parent.Range("J2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange .Parent.Range("A1:J" & mxR)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
③抽出用コード
Option Explicit
Sub 抽出()
Columns("B:J").Select
Selection.ClearContents
Sheets("Sheet1").Columns("A:H").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("A1:A2"), CopyToRange:=Range("B1"), Unique:=False
End Sub
④部署別出力用コード
Option Explicit
Sub 部署別出力()
Dim i As Long, shi As Long, myR As Long
Dim tbl As Variant
Dim ws As Worksheet
For shi = 1 To 1
With Sheets(shi)
tbl = .Range("A1", .Range("I" & Rows.Count).End(xlUp)).Value
End With
For i = 2 To UBound(tbl, 1)
On Error Resume Next
Set ws = Worksheets(tbl(i, 7))
On Error GoTo 0
If ws Is Nothing Then
Sheets.Add(after:=Sheets(Sheets.Count)).Name = tbl(i, 7)
Sheets(tbl(i, 7)).Range("A1:G1").Value = Array("表示商品名", "出庫月", "表示病棟名", "部署", "出庫数", "金額", "使用量")
Range("A1:G1").Select
Selection.AutoFilter
Range("H1").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,C[-1])"
Else
Set ws = Nothing
End If
With Sheets(tbl(i, 7))
myR = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & myR).Value = tbl(i, 8)
.Range("B" & myR).Value = tbl(i, 2)
.Range("C" & myR).Value = tbl(i, 7)
.Range("D" & myR).Value = tbl(i, 3)
.Range("E" & myR).Value = tbl(i, 4)
.Range("F" & myR).Value = tbl(i, 5)
.Range("G" & myR).Value = tbl(i, 6)
End With
Next
Next
End Sub
以上です。長くなりすみません。(Machi)
新スレ、ありがとうございます。
「Option Explicit」が何回か出てるのは それぞれモジュールを分けてますか？ Private Const ○○ って変数は、モジュール内でしか使えないので (Privateを外せば全体で使える様になりますが。。。） モジュールを変えると 同じ宣言が複数回必要になりますので 一つのモジュールに続けて書いてもらうと良いのではないかと思います。
そしたら、シート名が変わった時に 一か所だけ修正すれば済みますので。
((数式を入れる4))の、ソートの所ですが まぁ、全部入れてもらっても良いのですが ＞With Sheets(MainSh).Sort の中に入れるので「.SortFields.Clear」を入れて下さいね。 って事なのです。 「With Sheets(MainSh).Sort」の中にあるので Sortより前は「.」一個に出来ます。
((抽出))マクロは、うまく動いてますか？
そしたら、まず「Selection」をなくしたり "Sheet1"を変数にしたりして下さいね。
そして今度は、抽出シートのモジュール（今までは標準モジュールに書いてましたね）に
'------
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$2" Then
Call 抽出
End If
End Sub
'------
を書いて下さい。
「Worksheet_Change」と言うのは、セルの値が変わった時に 自動的に実行されるコードです。 抽出シートのどこかのセルの値が変わったら自動的に実行され 変化のあったセル（Target）のセル番地がA2だった時に、((抽出))マクロを実行する様なコードになっています。
((抽出))マクロ内で、セルの値を削除する部分～～Columns("B:J").ClearContents～～があるので
この時も、「Worksheet_Change」が実行されてしまうのですが、変化のあったセルがA2でないので
この時の「Worksheet_Change」は、何事もなく End Sub します。
「Worksheet_Change」等を利用するときは、そのあたりの注意も必要になってきますので気を付けて下さい。 今回は、このまま強行しておきます。
これらが完成したら、ついに((部署別出力))へ移りますね。
(HANA)
＞「With Sheets(MainSh).Sort」の中にあるので Sortより前は「.」一個に出来ます。
ここは、
With Sheets(MainSh).Sort
.SortFields.Clear
.SortFields.Add Key:=.Parent.Range("J2"), _ ……
ということで、良いでしょうか？
＞そして今度は、抽出シートのモジュール（今までは標準モジュールに書いてましたね）に…
ここは、以下のように繋げてしまって良いのでしょうか？
Sub 抽出()
Columns("B:J").ClearContents
With Sheets(MainSh)
.Columns("A:H").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("A1:A2"), CopyToRange:=Range("B1"), Unique:=False
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$2" Then
Call 抽出
End If
End Sub
（Machi)
＞＞「With Sheets(MainSh).Sort」の中にあるので Sortより前は「.」一個に出来ます。 ＞ ～～～～～ ＞ということで、良いでしょうか？ はい、そうです。
そのうち、ご自身で作ったコードをじっくり眺められる様に成ると 気づく様に成ると思いますけどね。
＞ここは、以下のように繋げてしまって良いのでしょうか？ ((抽出))の方は、そのまま標準モジュールで Private Sub Worksheet_Change ～～ を、抽出シートのシートモジュールです。
別のシートでも A1:A2に条件を入れて抽出したい時は ((抽出))マクロが使えますからね。
標準モジュールにコードを書いている時、Rangeの前に「何処のシートの！！」って書いていない場合 アクティブシートの事になります。 シートモジュールにコードを書いている時は、そのシートの事になります。
つまり、標準モジュールに((抽出))コードが有った場合 Column("B:J").ClearContents でクリアされるのは
その時アクティブに成っていたシートのB:J列（Sheet1がアクティブだったら、Sheet1のB:J列）ですが
抽出シートのシートモジュールに有った場合、どのシートがアクティブであっても
抽出シートのB:J列（Sheet1がアクティブでも、抽出シートのB:J列）に成ります。
(HANA)
ここに Private Sub Worksheet_Change ～～をコピペして、
実際に抽出シートでA2セルを変更すると、
コンパイルエラー「名前が適切ではありません：抽出」というエラーが出てしまいます。
あともう１つお聞きしたいのですが、
標準モジュールから1個1個作成していたマクロを、
１つに繋げたところ、開発タブからマクロを開いたときに
Module○○．データ収集、Module▽▽．データ収集といった感じで、
Module○○が前についたマクロがたくさん出てくるようになったのですが、
これはこのままでいいのでしょうか？（Machi)
そして、抽出シートでA2セルを変更したときに表示されていた
コンパイルエラー「名前が適切ではありません：抽出」というエラーも
表示されなくなりました。
今までのマクロを、もったいなく思って全部同じブックに入れておいたのが
いけなかったのでしょうか。すみません。（Machi)
いやいや、悪くないですよ。 色々やって見られるのが良いと思います。 ただ、同じものが 似たようなところに いくつもあると 「どれがいま使ってるやつだっけ？？？」ってなりかねませんので 注意が必要です。 （私はよくやります。。。）
一つのモジュール内に、同じマクロ名のコードを作ると 怒られます。 モジュールを分けると、同じマクロ名のコードが作れますが それぞれ違うコードなので 「Module○○．データ収集」「Module▽▽．データ収集」とそれぞれ違う呼び方をしないと Call データ収集 なんてした場合、どちらの((データ収集))を実行すれば良いのかわからないですよね。
さて、ついに((部署別出力))にとりかかりましょう。
まず、当初作ったコードですが、どの様になっているか眺めてみましたか？ 当初は、それぞれの部署がばらばらで出てきていた （シート毎では順番になっていたかもしれませんが。。。）ので 処理対象行毎（iの値が変わる毎）に、 その部署のシートがすでに作成されているか確認→ない場合は作成 On Error ～～ End If と言う処理が必要でした。 あ、オートフィルタと合計のコードが追加されていますね。 これも、Selectしない＆シート名明示 コードに変更してみて下さい。
そして、その行（一行ずつ）部署ごとのシートにデータを転記していました。 With Sheets(tbl(i, 7)) ～～ End With この間に、値を書き込むコードが7行ありますが、すべて 対象行(i)に関しての処理ですので 一行分だけ処理をしている事になります。
当初は、商品別のシートを順番に処理する予定でしたし 部署ごとのソートも行われているかいないのか 分からない状態でも動くように考えていたので、そのようなコードになったのですが 現在は、Sheet1が対象ですし 部署ごとにソート済なので、大きな流れとしては 部署のセルを順番に見て行って、下の行の部署名と変わった時 その部署のデータ開始行(StrR)から、その行(i)までのデータを転記 の繰り返しで良いですね。
Sheet1にある部署だけシートがあれば良いかと思っていましたが 対応表シートのE列に、部署名の一覧表があるので まず、すべての部署のシートを作るところからやろうと思います。
部署シート自体が無いより、部署シートはあるがデータが無い方が 「データが無かったのか」と思えるかと。。。
データの並びですが、
Sheet1 Array("商品名", "出庫月", "部署", "出庫数", "金額", "使用量", "表示病棟名", "表示商品名", "元シート", "昇順")
部署毎 Array("表示商品名", "出庫月", "表示病棟名", "部署", "出庫数", "金額", "使用量")
と、違っているので、そろえておくのが良いと思います。
どちらをどちらに合わせるのが良いかわからないので、とりあえず Sheet1を合わせる案。
Sheet1 Array("商品名", "表示商品名", "出庫月", "表示病棟名", "部署", "出庫数", "金額", "使用量", "元シート", "昇順")
また、使用者が少しでもシートを探しやすくするために 別ブックにしてみたいと思います。
'---- Sub メインシートから部署別出力() Dim i As Long Dim StrR As Long Dim tbl As Variant, Btbl As Variant
Btbl = Sheets(表Sh).Range("E3:E23").Value
With Sheets(MainSh)
tbl = .Range("A1", .Range("J" & Rows.Count).End(xlUp).Offset(1)).Value
End With
With Workbooks.Add
For i = UBound(Btbl, 1) To 1 Step -1
.Sheets.Add(Before:=.Sheets(1)).Name = Btbl(i, 1)
With Sheets(1)
.Range("A1:G1").Value = Array("表示商品名", "出庫月", "表示病棟名", "部署", "出庫数", "金額", "使用量")
.Range("A1:G1").AutoFilter
.Range("H1").FormulaR1C1 = "=SUBTOTAL(9,C[-1])"
End With
Next
For i = .Sheets.Count To UBound(Btbl, 1) + 1 Step -1
Application.DisplayAlerts = False
.Sheets(i).Delete
Application.DisplayAlerts = True
Next
StrR = 2
For i = 2 To UBound(tbl, 1) - 1
If tbl(i, 5) <> tbl(i + 1, 5) Then
.Sheets(tbl(i, 5)).Range("A2").Resize(i - StrR + 1, 7).Value = _
ThisWorkbook.Sheets(MainSh).Range("B" & StrR & ":H" & i).Value
StrR = i + 1
End If
Next
End With
End Sub
'----
((数式を入れる4))と関連するのですが
＞Btbl = Sheets(表Sh).Range("E3:E23").Value
は、セル番地を直接書いていますが ここも他の所と同じ様に
最終行を取得して、範囲が自動的に変更される様にしてください。
((数式を入れる4))だと、
昇順 = Sheets(MainSh).Range("G" & Rows.Count).End(xlUp).Row
.Range("J2:J" & mxR).Formula = "=MATCH(G2," & 表Sh & "!$E$3:$E$23,0)"
の所ですね。
「昇順」って変数がありますが、MainShのG列の最終行を探していますので 表ShのE列の最終行を探して、右辺に組み込んで下さい。 MainShの最終行は、mxRで良いんですよね？
(HANA)
＞MainShの最終行は、mxRで良いんですよね？
→はい。というか、mxRという言葉が最終行を表すのだと思っていました。
もしかして、別のシートで同じ名前の変数を使ってはいけないのでしょうか？
＞Btbl = Sheets(表Sh).Range("E3:E23").Value
＞は、セル番地を直接書いて言いますが ここも他の所と同じ様に
＞最終行を取得して、範囲が自動的に変更される様にしてください。
→ここは、以下で良いでしょうか？
Dim mxR As Long
mxR = Sheets(表Sh).Range("E" & Rows.Count).End(xlUp).Row
Btbl = Sheets(表Sh).Range("E3:E" & mxR).Value
これで、コードを実行すると、以下のエラーが表示されます。
（HANAさまに頂いたコードのまま実行しても、同じエラーが出ました）
「実行時エラー9；インデックスが有効範囲にありません」
.Sheets(tbl(i, 5)).Range("A2").Resize(i - StrR + 1, 7).Value = _
ThisWorkbook.Sheets(MainSh).Range("B" & StrR & ":H" & i).Value
別ブックに各表示病棟名のシートが作成されて
見出しと、オートフィルタ―と、計算式がＡ列に入りますが、
データ類は入っていない状態で、上記のエラーが表示される状態です。
ローカルウィンドウには、
+ : Module1 : : Module1/Module1
: i : 4 : Long
: StrR : 2 : Long
+ : tbl : : Variant/Variant(1 to 112, 1 to 10)
+ : Btbl : : Variant/Variant(1 to 21, 1 to 1)
- : Btbl(1) : : Variant(1 to 1)
: Btbl(1,1) : "Ａ５" : Variant/String
: mxR : 23 : Long と表示されていました。（Machi)
＞→ここは、以下で良いでしょうか？
＞昇順 = Sheets(表Sh).Range("E" & Rows.Count).End(xlUp).Row
＞.Range("J2:J" & mxR).Formula = "=MATCH(D2," & 表Sh & "!$E$3:$E$23,0)"
いや良くないです。。。ここも変数にして下さい。これが目的。・・・~~~＼ココ
変数：昇順 を作ったのは、$E$23の「23」部分を 自動的に変更させるためですよね？
＞ →はい。というか、mxRという言葉が最終行を表すのだと思っていました。 ＞もしかして、別のシートで同じ名前の変数を使ってはいけないのでしょうか？ 変数ってのは「メモ帳」だと思ってください。 mxRと言う名前のメモ帳。昇順と言う名前のメモ帳。
で、Dim mxR As Long って書いておくとこのメモ帳は 「-2,147,483,648～2,147,483,647の範囲」の値が一つだけメモが出来るメモ帳（メモ用紙） と言う事になります。
最初、何も書いていない状態では このメモ帳は白紙です。
最終行の行数として mxR を使うには、使う時までに
最終行の行数を mxR に入力しておかないといけないです。
それが
＞mxR = .Range("C" & Rows.Count).End(xlUp).Row
の行です。
これがあるから、mxRと言う変数には 最終行の行番号が入っています。
もしも mxR = 4 って書いてあると、mxRと言う変数には「4」と言う値が入っている事になります。
当然のごとく変数を使ったコードから入っているので そのあたりの部分が曖昧なまま 進んでこられたかもしれないですね。
((メインシートから部署別出力))のコードの変数の宣言部分ですが
Dim i As Long
Dim StrR As Long
Dim tbl As Variant, Btbl As Variant
自分でいろんな名前のメモ帳（メモ用紙）を用意するんです。
それで、そこに好きなものを入れる。
StrR って変数だと 最初「StrR = 2」2と言う値を入れて その後ループ処理の中で「StrR = i + 1」の様に変更して行きます。
Sheet1の最初の部署の始まりの行は 2行目ですね。 で、順番に確認していって、4行目迄入っていたとします。 4行目の部署の名前と5行目の部署の名前が一緒でない ってので、部署の境目を判断してます。 すると、二番目の部署の開始の行は 4+1 = 5行目から って事になります。 この「5」って数字を StrR って変数にメモっておきます。 なんでメモっておくかと言うと、あとから ○～×行目を転記して！！ って書くためです。 実際のコードだと、丁度エラーになって止まる行ですね。。。
((数式を入れる4))のコードだと、 Dim mxR As Long Dim 部署名 As Long, 物品 As Long Dim 昇順 As Long ってしてありますよね。
mxRって変数は、ずっと使う値を入れてますね。 Sheet1のデータがある最終行数を入れているので。 最後の数式を入れる時まで mxR って変数のお世話になります。
その他の変数は、一回（二回？）使用したら あとは覚えておかなくて良い値ですね。 例えば、変数：部署名 は G列に数式を入れる所で使ったら 後は使いません。
メモ用紙に 対応表シートのH列の最終行を書いて 数式を埋め込む時、そのメモ用紙を見ながら数式を作って それが終わったら、極端な話 メモ用紙の数字は 消しゴムで消してしまって問題ないですよね。 これより後は、もう使わない値なので。
分かりにくくなるのでお勧めはしませんが、 変数（メモ用紙）の数を少なくしたければ、次の 変数：物品 に入れていた 対応表シートのH列の最終行数も、先ほど使ったメモ用紙に書けば良いです。 変数の宣言で ○○ As Long ってやっているので 値が一つしか入れられないので もともと入っていた値は消える事になりますが、消えてしまって問題ないので。
。。。って感じなんですが、変数のイメージが少しでもわかりましたか？
変数を使う（値を変数に入れよう！！と思う）には、いろいろな理由がありますが 今回は「この値を、何箇所かで使いたい」ってのが主な理由です。
左辺の .Range("G2:G" & mxR).Formula ってな所をすべて
.Range("G2:G" & .Range("C" & Rows.Count).End(xlUp).Row).Formula
って書くと、長いですし 効率も落ちます。
右辺だって、たいてい2回は出てくるので その都度 Range("○○" & Rows.Count).End(xlUp).Row
って書いていると、わかりにくくなりますよね。
＞→ここは、以下で良いでしょうか？
＞Dim mxR As Long
＞mxR = Sheets(表Sh).Range("E" & Rows.Count).End(xlUp).Row
＞Btbl = Sheets(表Sh).Range("E3:E" & mxR).Value
はい。そんな感じにして下さい。それで問題ありません。
個人的には、((数式を入れる4))で、同じ～～対応表シートのE列の最終行を取得する～～があるので 同じ変数名にしておいた方が、後で見直した時に 分かりやすいかと思います。
変数の名前は何を付けても良いのですが、 例えば「青い箱には良品を入れる。赤い箱には不良品を入れる」と自分ルールを作っておけば 「良品はどの箱に入れたんだっけ？」と、これまでの行動を振り返る（コードを上方向に読み返す） 頻度が少なくなると思います。
＞これで、コードを実行すると、以下のエラーが表示されます。 えっと、コードが横着だったかもしれませんが。 ＞StrR : 2 : Long って事は、まだ最初の部署の転記ですね。 ＞i : 4 : Long ですので tbl(i, 5) → tbl(4, 5)の値 が何になっているでしょうか？
対応表シートの E3:E23 に出てくる部署名のシートは事前に作ってありますが それ以外の部署があった場合、その名前のシートは有りません。 存在しないシートに書込しなさいと命令すると 【インデックスが有効範囲にありません】→そんなシートないんだけど！！ と怒られます。。。
ってのが、一番有りそうなエラーなんですが。 このエラーメッセージは、その他の状態でも出るので「＝シートが無い」って 事にはならないのですが、今回はそれが一番考えやすいエラーなので。
エラーが出て止まっている時、マウスポインタを コード内の色々な所に近づけてみて下さい。 変数の中身。どの部分がエラーなのか 分かることがありますので 調べてみてもらえると良いのですが。。。
ちなみに、i とか StrR とか無くすと ↓の様になってます。
.Sheets(tbl(4, 5)).Range("A2").Resize(3, 7).Value = _
ThisWorkbook.Sheets(MainSh).Range("B2:H4").Value
コードがあるブックと、Sheet1（MainSh）があるブックが違っていると これまたエラーになりますが それは大丈夫ですよね？
(HANA)
＞ 。。。って感じなんですが、変数のイメージが少しでもわかりましたか？
→うぅ…。わからない≧何となくわかる、という感じです。
変数は、値を一時的に保存するためのメモ用紙みたいなもの。
変数を使うには、これからこの変数を使うからね、という宣言であるDim ▽▽～が必要で、
宣言した変数には値を入れる必要があり、これが、▽▽＝～～の部分でしょうか？
＞変数（メモ用紙）の数を少なくしたければ、……
これは、ずっと同じ値で変数を使わないのであれば、
▽▽＝～～の、「～～」部分を変更してもいい、という意味で合っていますか？
＞【インデックスが有効範囲にありません】→そんなシートないんだけど！！
→多分、これでした。
tbl(i, 5) → tbl(4, 5)の値は、元データの部署名でした。
ので、以下のように表示病棟名に修正したところ、全部のデータが出力できました。
If tbl(i, 4) <> tbl(i + 1, 4) Then
.Sheets(tbl(i, 4)).Range("A2").Resize(i - StrR + 1, 7).Value = _
ThisWorkbook.Sheets(MainSh).Range("B" & StrR & ":H" & i).Value
＞コードがあるブックと、Sheet1（MainSh）があるブックが違っていると
＞これまたエラーになりますが それは大丈夫ですよね？
→はい。ここは大丈夫そうです。
質問なのですが、
For i = UBound(Btbl, 1) To 1 Step -1 と、
For i = .Sheets.Count To UBound(Btbl, 1) + 1 Step -1 と、
For i = 2 To UBound(tbl, 1) - 1 この、３つのコードは、
訳すとどのような意味になるのでしょうか？ （Machi)
変数：昇順 の件。 その様にして貰うつもりで書いてました。
変数名についてはそんな感じです。
説明が重複しますが、こんなのを作ってみました。
あくまでもサンプルなので、実際にこんな簡単なコードでしたら
変数に入れずに直接セルに結果を入れるでしょうけど。。。
'------
Sub sample1()
Dim A列の合計 As Long, B列の合計 As Long, C列の合計 As Long, AAA As Long
A列の合計 = Range("A2").Value + Range("A4").Value + Range("A6").Value
Range("A8").Value = A列の合計
B列の合計 = Range("B2").Value + Range("B4").Value + Range("B6").Value
Range("B8").Value = B列の合計
C列の合計 = Range("C2").Value + Range("C4").Value + Range("C6").Value
Range("C8").Value = C列の合計
End Sub
'------
Sub sample2()
Dim 次で使う合計 As Long
次で使う合計 = Range("A2").Value + Range("A4").Value + Range("A6").Value
Range("A8").Value = 次で使う合計
次で使う合計 = Range("B2").Value + Range("B4").Value + Range("B6").Value
Range("B8").Value = 次で使う合計
次で使う合計 = Range("C2").Value + Range("C4").Value + Range("C6").Value
Range("C8").Value = 次で使う合計
End Sub
'------
sample1 と sample2 は同じ結果になりますが 片方は変数を３つ使って、片方は１つしか使ってません。
たとえば、End Sub の前に もう一度 A列を合計した値が欲しい場合 sample1 だと、A列の合計 と書くだけで良いですが sample2 だと、もう一度 A2+A4+A6 の計算が必要に成ります。
また、「今動いている変数の値」を知りたい時は sample1だと、どの変数が動いているか気をつけて確認が必要ですが sample2だと、一つの変数だけ見ておけば良いですよね。
ご自身で分かりやすい方を選んでもらえると良いと思います。
折角変数の話になっているので、前回保留にした話を蒸し返しておきます。
((抽出5))のコードで
＞ Dim 抽出 As Long
＞ 抽出 = Sheets(抽出Sh).Range("A2") →ここで型が一致しませんとエラーが出る
って問題です。
抽出シートのA2セルには、これから抽出したい部署名を入れましたね？ って事は、これは「文字」です。
一方、変数：抽出の型は Long「2,147,483,648～2,147,483,647の範囲の値」 で宣言して有ります。
「数値をいれるからね」って言っていたのに、文字を入れようとしたので エクセル君が「間違ってるんじゃないの？」って教えてくれてます。 これが、わざわざ変数の型（As ○○）を一緒に書いておく効果です。
・・・まぁ、この時は そもそもこの変数が要らなかったんですけどね。
＞tbl(i, 5) → tbl(4, 5)の値は、元データの部署名でした。 あら～、失礼しました。
ただ、先に説明した様に、E3:E23 に出てくる部署名以外の物が有った場合は エラーに成って止まりますので、注意して下さい。
その場合は、部署名を追加して 数式を入れる→メインシートから部署別出力 と、順番に再実行をやってもらうか、数式は多分入ったままなので セルの挿入で、数式の参照範囲を拡張して 部署名を追加後、部署別出力を実行 して貰えると良いと思います。
＞質問なのですが、 ってのは、ループ処理（For ～ Next）の方の質問では無く UBound の方の質問ですよね？ ヘルプには ◆配列の指定された次元で使用できる添字の最大値を、長整数型 (Long) の値で返します。 って書いてあります。
先ほどエラーが出た時 tbl : : Variant/Variant(1 to 112, 1 to 10) って成ってましたね。 これは、変数：tbl が、112行×10列の表 って事です。
なので、UBound(tbl, 1) ってのは 112 UBound(tbl, 2) と書くと、10 の値が返って来ます。
Btbl : : Variant/Variant(1 to 21, 1 to 1) だったので、UBound(Btbl, 1) は「21」ですね。
ループ処理の方は大丈夫ですか？
For i = 1 To 10 ※何か処理※ Next
で、iの値を一つずつ 1～10まで増やしながら ※何か処理※ を行います。
For i = 10 To 1 Step -1 ※何か処理※ Next
と書いてあると、iの値を10～1まで一つずつ減らしながら ※何か処理※ を行います。
たとえば、
For i = 1 To 10 Step 2 って書いてあると、iの値は二つずつ上がっていきます。
※何か処理※ の所を MsgBox i なんてコードに置き換えて 確認してみて貰うと、分かりやすく成るかもしれません。
[F8]で一つずつ実行しながら ローカルウィンドウ等で iの値を確認して貰っても良いと思いますが。
この前、載せてもらったコードを見ていて思ったのですが ((数式を入れる4))の MxR に値を入れる所は 折角 With の中に入っているのに、最初の「.」が無いですね。
そういった細かい所にも気をつけながら 再度コードを見直しておいて貰えると良いと思います。
(HANA)
＞これが、わざわざ変数の型（As ○○）を一緒に書いておく効果です。
実感しました～。
この質問をしていた時に、たまたま職場にいた事務の方に、
LongがあるならShortもあるの？と聞いたらば、
とっても冷たい目で見られ、「そのくらいのこともわからないまま、質問するのは失礼だよ。」と指摘されました(>_<)。
という訳で、先日すぐわかるエクセルマクロ、VBAなる本を購入してみました。
HANAさまに教えて頂いたことを、この本を読みながら復習していこうと思います！
ちなみに今は「BVAの基本用語：プロパティ・オブジェクト」です。
＞UBound の方の質問ですよね？
はい。ヘルプを読んでも何を言われているのかよくわからなかったのです。
購入した本にも載っていませんでしたが、説明していただき、やっとわかりました。
＞ループ処理の方は大丈夫ですか？
もちろん大丈夫ではなかったのですが、HANAさまの説明で理解できました。
＞((数式を入れる4))の MxR に値を入れる所は
＞折角 With の中に入っているのに、最初の「.」が無いですね。
最初は、とりあえず先頭に「．」つける必要があるのだと思い、
．MxR＝～としたのですがダメだったので、そのままにしていました。
他のコードを確認したところ、MxR=．～とすれば良いことに気が付きました。
このあとは、Sheet1に「データ収集（様式１、様式２）」＋「数式を入れる」、「データ出力」の
２つのボタンを用意して、ポチっと押せばいいように原本を作成したいと思います。
データ収集のコードと、数式を入れるコードを合体させるときは、
どのようにすれば良いのでしょうか？
また、Subデータ収集のコードを実行すると、Sub様式１とSub様式２の
コードも同時に実行されますが、これは何故同時に実行してくれるのでしょうか？（Machi)
＞とっても冷たい目で見られ、「そのくらいのこともわからないまま、質問するのは失礼だよ。」と指摘されました(>_<)。 なかなか厳しい方ですね。＾＾；
＞という訳で、先日すぐわかるエクセルマクロ、VBAなる本を購入してみました。 最初から読んで理解しようと思うと、嫌になってもいけませんので まずは「どんな事が書いてあるか」が分かることを目指されると良いと思います。
で、実際に事に当たった時に「あ、あの本に書いてあったな」ってのを思い出して 読む様にした方が、分かりやすいと思います。
どのような本を購入されたのか分からないですが、 あまり理屈ばかりを追いかけるのも大変だと思うので 文字ばかりの所は、まずは程々に。。。
＞．MxR＝～としたのですがダメだったので、そのままにしていました。 ＞他のコードを確認したところ、MxR=．～とすれば良いことに気が付きました。 そうですね。 このあたりが、基本を飛ばしてしまった弊害ですよね。
前スレにも少し書いているので、戻って確認してみてください。 ちょっと長いので 「Opetion Explicit」←カギカッコが付いた状態 のワードを検索してみてください。 その時に投稿した中に書いてあります。
たぶん、同じ説明になりますが もう一度書いてみますね。 Withの中に入っていると、その後ろに付いている物が「.」で省略できます。
今は
With Sheets(MainSh)
mxR = Range("C" & Rows.Count).End(xlUp).Row
End With
こんなコードです。
mxRの前に「.」を付けると
Sheets(MainSh).mxR = Range("C" & Rows.Count).End(xlUp).Row
Rangeの前に「.」を付けると
mxR = Sheets(MainSh).Range("C" & Rows.Count).End(xlUp).Row
こうなりますね。
って、なってると 分かりますか？ 変数：mxR は、シートが何とか、関係無いですよね。 値を入れるメモ帳ですから。
一方「セル」と成ると どこのシートのセルなのか ってのは重要です。 Sheet1とSheet2のデータ量が違えば Sheet1のシートで最終行を探すのと、Sheet2のシートで最終行探すのでは 結果が違ってきますので。
＞データ収集のコードと、数式を入れるコードを合体させるときは、～～ の前に ＞何故同時に実行してくれるのでしょうか？ の方を書いてみますね。
ステップインで実行してもらうと、どの順番で何処が実行されるか分かるので 納得しやすいと思いますが。
まず、Sheet1の1行目に見出しを設定します。 で、左から3番目のシートから順番に処理をする ループ処理が始まります。
まず、3番目のシートをセレクト（アクティブに）して
A1セルの値を確認。
セルの値が"[9]ＳＰＤ"だったら、様式1 って事でしたね。
さらにデータが有った時だけ転記処理をすればよいので
データの有無を確認します。
それが If Range("A5").Value <> "" Then の部分です。
A5セルに何か値があったら、データが有るという事なので
◆Call 様式1 '石鹸マクロ
((様式1))マクロを呼び出します。
ステップインで実行してみてもらうと この部分が黄色くなった後は すぐに次の行に移るのではなく ((様式1))マクロの方にハイライトが移っていくのが確認できると思います。
((様式1))マクロが最後まで済んだら、((データ収集))マクロの 続きの行へ戻ります。
((様式2))に関しても同じです。 途中で Call している部分が有りますよね。
つまり
＞データ収集のコードと、数式を入れるコードを合体させるときは、～～
Sub 一連処理()
Call データ収集
Call 数式を入れる4
End Sub
ってやってもらったら良いです。
それから、これはそちらの使用状況によると思いますが ((データ収集))マクロは一度しか実行しないと思います。 もしももう一度実行するときは、前回集めたSheet1のデータは 削除してしまう場合だと思います。
なので、見出しを入れる前に データのクリア処理を 入れておいた方が良いのではないかと思いますが。。。
例えば、 「この前渡したデータのこのシートのデータが間違ってたから、差し替えて」なんて言われた時 「全部の物品シートがそろってないけど、あるものだけでとりあえず集計したい」なんて時に 再度実行する事を考えたら、先に手作業で削除するとか個別に対応するとか しても良いと思いますが、((一連処理))のボタン一つで済んだ方が楽だと思いますので。
(HANA)
＞ステップインで実行してもらうと、どの順番で何処が実行されるか分かるので～
最初の頃に、ステップアップで実行したのですが、
上に行ったりしたに行ったりする動きについていけず、途中でギブアップでした。
今回は、あらかじめ何をしているのかわかっていたためか、よくわかりました！
＞なので、見出しを入れる前に データのクリア処理を～
はい。実は、今までもＳheet１にクリアボタンを作成して使用していました。
なにせ、何度も何度も繰り返してやってみないと、わからなかったものですから…。
おかげさまで、当初の理想以上の出来栄えとなりました。
まったくわかっていないMachiに、時間を割いて丁寧に教えて頂きありがとうございました。
VBAって素敵だわ～と感激しているところなので、身の回りにある面倒なことを
少しずつ楽にしていけるよう工夫したいな、と野望を抱いたところです。
Shortがデータの型にないことはわかりましたしね(/ω＼)。
ありがとうございました。
（Machi)
＞はい～。さっそくCallという項目を探したのですが、 ＞載っていませんでした(T_T)。「超！！初心者用」だからかもしれません。残念…。 そうですね。 Webで探した方が、見つかりやすいかもしれません。 書籍もWebも一長一短あると思いますので イイトコドリ して 上手に活用出来ると良いと思います。
＞はい。実は、今までもＳheet１にクリアボタンを作成して使用していました。 あ、そうなんですか。 無い方が便利だから、コードから削除されたのかと思ってました。
＞おかげさまで、当初の理想以上の出来栄えとなりました。 そうですか。それは良かったです。
一応最後に完成品を載せてみてもらえませんか？ 何か気付く所が有るかもしれませんので。
＞身の回りにある面倒なことを ＞少しずつ楽にしていけるよう工夫したいな、と野望を抱いたところです。 是非是非、挑戦してみてください。 数式や一般機能なんかも使えるようになると また便利になると思います。
＞Shortがデータの型にないことはわかりましたしね(/ω＼)。 でも、Single と Double はありますよ。 Triple ってのは、やっぱり無いですが。
(HANA)
＞Webで探した方が、見つかりやすいかもしれません。
本当にたくさん、VBAの使い方系のHPがあるんですね。
なにせ、こちらのHPに投稿した後に見たHPで、「何も分からない状態で、質問するな」的なことが
トップページに書かれているのを読んで、恐ろしくなってしまい以降はここしか見ていなかったのです～(>_<)。
今後ゆっくりと、色々な方のHPを拝見しようと思います。
＞一応最後に完成品を載せてみてもらえませんか？
＞何か気付く所が有るかもしれませんので。
ありがとうございます！
改行の仕方？タブの入れ方？？（HANAさまのコードは綺麗な形してますよね？）は
まったくわかりませんので、ただ単に入力したままになっちゃいました。
あと、Callで呼び出すコードをどこに入れるか迷ったのですが、
一番最初のところに入れちゃいました。
Option Explicit
Private Const MainSh = "Sheet1"
Private Const 表Sh = "対応表"
Sub 一連処理()
Call データ収集
Call 数式を入れる4
End Sub
Sub データ収集()
Dim i As Long
With Sheets(MainSh)
.Range("A1:J1").Value = _
Array("商品名", "表示商品名", "出庫月", "表示病棟名", "部署", "出庫数", "金額", "使用量", "元シート", "昇順")
For i = 3 To Worksheets.Count
Sheets(i).Select
If Range("A1").Value = " [9]ＳＰＤ" Then
If Range("A5").Value <> "" Then
Call 様式1 '石鹸マクロ
End If
Else
If Range("B8").Value <> "" Then
Call 様式2 '消毒薬マクロ
End If
End If
Next
.Select
End With
End Sub
Sub 様式1()
'＝＝石鹸マクロ 5行目以降がデータ
Dim RCnt As Long, myR As Long
RCnt = Range("A" & Rows.Count).End(xlUp).Row - 4
With Sheets(MainSh)
myR = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & myR).Resize(RCnt).Value = Range("A2").Value '商品名
.Range("C" & myR).Resize(RCnt).Value = Range("D5").Resize(RCnt).Value '出庫月
.Range("E" & myR).Resize(RCnt).Value = Range("B5").Resize(RCnt).Value '部署
.Range("F" & myR).Resize(RCnt).Value = Range("G5").Resize(RCnt).Value '出庫数
.Range("G" & myR).Resize(RCnt).Value = Range("J5").Resize(RCnt).Value '金額
.Range("I" & myR).Resize(RCnt).Value = ActiveSheet.Name 'シート名
End With
End Sub
Sub 様式2()
'＝＝消毒薬マクロ 8行目以降がデータ
Dim RCnt As Long, myR As Long
RCnt = Range("B" & Rows.Count).End(xlUp).Row - 7
With Sheets(MainSh)
myR = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & myR).Resize(RCnt).Value = Range("D6").Value '商品名
.Range("C" & myR).Resize(RCnt).Value = Range("C4").Value '出庫月
.Range("E" & myR).Resize(RCnt).Value = Range("B8").Resize(RCnt).Value '部署
.Range("F" & myR).Resize(RCnt).Value = Range("M8").Resize(RCnt).Value '出庫数
.Range("G" & myR).Resize(RCnt).Value = Range("P8").Resize(RCnt).Value '金額
.Range("I" & myR).Resize(RCnt).Value = ActiveSheet.Name 'シート名
End With
End Sub
Sub 数式を入れる4()
Dim mxR As Long Dim 部署名 As Long, 物品 As Long Dim 昇順 As Long
With Sheets(MainSh)
mxR = .Range("C" & Rows.Count).End(xlUp).Row
.Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
.Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
部署名 = Sheets(表Sh).Range("H" & Rows.Count).End(xlUp).Row
.Range("D2:D" & mxR).Formula = _
"=IF(COUNTIF(" & 表Sh & "!$H$2:$H$" & 部署名 & ",E2),VLOOKUP(E2," & 表Sh & "!$H$2:$I$" & 部署名 & ",2,FALSE),""その他"")" '病棟名を統一
物品 = Sheets(表Sh).Range("A" & Rows.Count).End(xlUp).Row
.Range("H2:H" & mxR).Formula = _
"=IF(COUNTIF(" & 表Sh & "!$A$2:$A$" & 物品 & ",A2),F2*VLOOKUP(A2," & 表Sh & "!$A$2:$B$" & 物品 & ",2,FALSE),""？"")" '物品名から使用量を出す
.Range("B2:B" & mxR).Formula = _
"=IF(COUNTIF(" & 表Sh & "!$A$2:$A$" & 物品 & ",A2),VLOOKUP(A2," & 表Sh & "!$A$2:$C$" & 物品 & ",3,FALSE),""？"")" '物品名をわかりやすくする
昇順 = Sheets(表Sh).Range("E" & Rows.Count).End(xlUp).Row
.Range("J2:J" & mxR).Formula = "=MATCH(D2," & 表Sh & "!$E$3:$E$" & 昇順 & " ,0)" '病棟順に並べかえるために数字を入れる
End With
With Sheets(MainSh).Sort '病棟順に並び替える
.SortFields.Clear
.SortFields.Add Key:=.Parent.Range("J2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange .Parent.Range("A1:J" & mxR)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Sub 抽出()
'選択した病棟のみデータを見る
Columns("B:J").ClearContents
Range("B1:I1").AutoFilter
Range("J1").Formula = "=SUBTOTAL(9,C[-1])"
With Sheets(MainSh)
.Columns("A:H").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("A1:A2"), CopyToRange:=Range("B1"), Unique:=False
End With
End Sub
抽出用シートに、
Private Sub Worksheet_Change(ByVal Target As Range) →この(ByVal～）というのは、シートモジュールに入れるときに必ず入るものなのでしょうか？
If Target.Address = "$A$2" Then
Call 抽出
End If
End Sub
Sub メインシートから部署別出力()
Dim i As Long
Dim StrR As Long
Dim tbl As Variant, Btbl As Variant
Dim 昇順 As Long
昇順 = Sheets(表Sh).Range("E" & Rows.Count).End(xlUp).Row
Btbl = Sheets(表Sh).Range("E3:E" & 昇順).Value
With Sheets(MainSh)
tbl = .Range("A1", .Range("J" & Rows.Count).End(xlUp).Offset(1)).Value
End With
With Workbooks.Add
For i = UBound(Btbl, 1) To 1 Step -1
.Sheets.Add(Before:=.Sheets(1)).Name = Btbl(i, 1)
With Sheets(1)
.Range("A1:G1").Value = Array("表示商品名", "出庫月", "表示病棟名", "部署", "出庫数", "金額", "使用量")
.Range("A1:G1").AutoFilter
.Range("H1").Formula = "=SUBTOTAL(9,C[-1])"
End With
Next
For i = .Sheets.Count To UBound(Btbl, 1) + 1 Step -1
Application.DisplayAlerts = False
.Sheets(i).Delete
Application.DisplayAlerts = True
Next
StrR = 2
For i = 2 To UBound(tbl, 1) - 1
If tbl(i, 4) <> tbl(i + 1, 4) Then
.Sheets(tbl(i, 4)).Range("A2").Resize(i - StrR + 1, 7).Value = _
ThisWorkbook.Sheets(MainSh).Range("B" & StrR & ":H" & i).Value
StrR = i + 1
End If
Next
End With
End Sub
クリア用のボタンは
Option Explicit
Sub Sheet1クリア()
Sheets("sheet1").Columns("A:J").ClearContents
End Sub
＞是非是非、挑戦してみてください。
そうします～。
現在、「フォームコントロールで作成されたチェックボックスを
指定した行ごとに一斉にオフにする」というマクロを作成しようと夢見ています。
毎日毎日、50個くらいあるチェックを、
１つずつポチポチするのが大変なので、頑張るぞ～と思っていますが、
「リンクを貼ってないチェックボックスは、大変なんじゃない？」と
例の厳しい事務さんに言われて、ウソー(T_T)となっています。
がしかし、いやいや諦めるな私！！と、奮起しました。
＞数式や一般機能なんかも使えるようになると また便利になると思います。
↑ここに辿りつけることを祈ります、ホントに…。（Machi)
＞なにせ、こちらのHPに投稿した後に見たHPで、「何も分からない状態で、質問するな」的なことが ～～ いろんな掲示板がありますからね。 投稿するのなら、どんな雰囲気の掲示板なのか良く見極めてからにすると そんなに心配しなくても大丈夫だと思いますよ。
この掲示板では、自称ですが「あんたがやりなさいよ」ってのは 私が良く言っている方だと思います。
今回のやり取りの中でもMachiさんに実際に 手を動かしたり 眼を動かしたり 頭を動かしたり してもらいましたよね。 関数の使い方なんかも、調べてもらったと思います。
他の回答者さんは、親切な方が多いので 要件をしっかり聞いて 「じゃあ、これで動かしてみて」って コードを丸ごと載せてくれる方が多いです。 私は、「あんたが楽になるんだから、少しは苦労しないとね」と思って 完成品を載せない事もあります。 で、「自分で調べたら～？」なんて書くので、『お前がそんなに偉いのか！！』って 大バッシングを受けたりします。。。
Machiさんが根気よく付き合ってくれて良かったです。
＞改行の仕方？タブの入れ方？？ これは、いろんな人のコードを見て「素敵だ！！」と思える物を 真似していけば良いと思います。
結局は、読みやすくする為に入れるので、基本的には 影響を受けている間 を一段下げますね。 例えば、 Wiht ○○ ～ End With の間は With ○○ の影響を受けるので一段下げる If ×× Then ～ End If も、If で True に分岐した時にだけ実行されるので一段下げる みたいな。。。
でも、見た目のウツクシサも追求したいですよね！！ コメントにすると、色が変わるので コメントはコメントでインデントをそろえたい とか。 そんなので、無駄に時間を使ったりします。＾＾；
そうそう、コメントにすると色が変わるので、マクロの変わり目を分かりやすいように '------ こんなのを入れて区切っても良いと思います。
Sub 一連処理() ： End Sub '---------- '---------- Sub データ収集() ： End Sub '---------- Sub 様式1() ： End Sub '---------- Sub 様式2() ： End Sub '---------- '---------- Sub 数式を入れる4() ： End Sub '---------- '---------- ： って感じにすると、後から何か変更したい時に 探しやすくなるかな～ と思います。
Callで呼び出すコードは、先頭で良いと思います。 上から順に実行される様に成りますよね。
コードの方ですが ＞Private Sub Worksheet_Change だけ 別のモジュール（シートモジュール）で 他のは、全部同じモジュールに入れてありますよね？
((データ収集))コードですが
＞＞見出しを入れる前に データのクリア処理を入れておいた方が良い
ってのは、
＞With Sheets(MainSh)
の後に
.Columns("A:J").ClearContents
を入れるって事だったのですが。。。
それから((Sheet1クリア))を残すなら
これも変数を使っておいた方が良いと思います。
((メインシートのデータをクリア))的な名前にして
Sheets(MainSh).Columns("A:J").ClearContents
みたいに。
((数式を入れる4))のコメントは、今は入れる数式を書いた後に続けて書いてますが 上側に持ってきた方が見やすくなるかもですね。
'病棟名を統一
部署名 = Sheets(表Sh).Range("H" & Rows.Count).End(xlUp).Row
：
'物品名から使用量を出す(H列)
'物品名をわかりやすくする(B列)
物品 = Sheets(表Sh).Range("A" & Rows.Count).End(xlUp).Row
：
って感じで。
もちろん、位置は 数式を入れるセル番地が書いてある行の上の方が見やすいと思えば そちらに書いてください。
あとは、コードを書きながら迷ってた所ですが With Sheets(MainSh) ： End With With Sheets(MainSh).Sort '病棟順に並び替える ： End With って所は With Sheets(MainSh) ： With .Sort '病棟順に並び替える ： End With End With って書いても同じです。
ここを書き換えたからって、動きが格段に違ってくる なんてこともないと思いますが。 一旦 End With とした方が一息つける気もするし 同じシートに対しての処理なので、一気にたたみかけても良い様にも思えます。
((抽出))で使った「詳細設定」については どんな機能か確認してみてもらえましたか？ 今は特定の１つの病棟だけを抜き出すのに使ってます。 例えば、複数の病棟を同時に抜き出したり 病棟以外の項目を指定して抽出したりもできます。
今は抽出条件をA列に書いて、B列以降に結果を表示してますが A列から結果を表示し、K列以降に抽出条件を書く事にして 条件が書いてあるセル範囲もVBAで取得して使う様にすると さらに色々な事に使える様になるのかもしれません。
。。。オートフィルタの方が使い慣れていて すばやく操作ができるかもしれませんが。
シートモジュールに書いたコードですが ＞この(ByVal～）というのは、シートモジュールに入れるときに必ず入るものなのでしょうか？ あったり、無かったり。。。です。
Option Explicit の上に [ ▼][ ▼]ってあると思います。 今使ってるコードだと [ Worksheet ▼][ Change ▼]ってなってると思います。 後ろ側の▼を開くと、色々選べるようになってます。
例えば先頭の Activate を選んでもらうと Private Sub Worksheet_Activate() 何も入ってません。 これは、このシートがアクティブになった時に自動的に実行されます。
BeforeDoubleClick は Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) これは、ダブルクリックした時に自動的に実行されます。 Target ってのは、同じですね。ダブルクリックされたセルがどのセルなのかが格納されてます。 その後ろの Cancel ってのは、セルをダブルクリックしたら 編集状態（セルの中にカーソルが入る）になりますよね。 Cancel = True と書いておくと、編集状態になりません。
こんなコードだと、どうなるか 想像しながら
いろんなセルをダブルクリックしてみてください。
'------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Application.Intersect(Target, Range("B2:C10")) Is Nothing Then
Cancel = True
End If
End Sub
'------
Application.Intersect ってのは、「複数のセル範囲の共有セル範囲を表す Range オブジェクトを返します。」
たとえば、ダブルクリックしたセル(Target)が、B5セルだったら
B2:C10セル範囲との共有セル範囲 ＝ B5セル を返すので Is Nothing は FALSE です。
つまり、Cancel = True には分岐しません。
Targetが、A1セルだったら、共有セル範囲は無いので Cancel = True が実行されます。
＞現在、「フォームコントロールで作成されたチェックボックスを ＞指定した行ごとに一斉にオフにする」というマクロ でしたら、もしかしたら Web上を探すと見つかるかもですね。 ＞毎日毎日、50個くらいあるチェックを、１つずつポチポチ してる人って、結構いそうな気がします。
で、そんな内の一人が「面倒なんだけど、なんとかならない？」って 質問してそうな気がします。 調べもせずに、勝手な事を書いてますが。
ここまで偉そ気な事を色々書いてきましたが コードの方は突っ込まれると冷や汗が出るくらい分かってないですし コントロール系に至っては、自信をもって「分からないよ」って言えるくらい分からないので。(つ∀<○)
こんなんでコメントつけてるんですから それこそ 「何も分からない状態で、回答するな」って言われてもおかしくないんですけどね。
(HANA)
＞でも、見た目のウツクシサも追求したいですよね！！
→いつかここまで余裕をもって考えられるようになりたいです。
とりあえず、間違えて変なことろで改行しないように気を付けたいです。
＞コードの方ですが～ 他のは、全部同じモジュールに入れてありますよね？
はい。データクリアは別のモジュールになっていますが（初期に作成したので）
他のコードは、モジュール１に入っています。
データ収集系のコードを実行するとき、ホントに大丈夫かな？といつもドキドキしながらやっていたのです（今もですが）。
なので、自分の心の準備のために、データクリアのみ単独で実施したあとに、
それ以降のデータ収集系のコードを実行する、という感じの流れでした（笑）。
ご指摘いただいた通り、モジュール１に入れて、
Sheets(MainSh).Columns("A:J").ClearContents としたいと思います。
＞((数式を入れる4))のコメントは、今は入れる数式を書いた後に続けて書いてますが…
→コードの途中（Sub～EndSubの間でも）に改行して入れても大丈夫なんですね！
さっそく、変更しようと思います。
＞あとは、コードを書きながら迷ってた所ですが～一旦 End With とした方が一息つける気もするし…
ここは、現行通りにしようと思います。
いったん、End Withにしてあったほうが、自分で理解しやすいものですから。
＞ ((抽出))で使った「詳細設定」については どんな機能か確認してみてもらえましたか？
→HANAさまが求めるレベルで確認できているとは思えませんが(>_<)、
フィルタオプションについて調べていた時に、
抽出について詳細に説明してくれているところがあったので、そこを参考にしました。
そちらを見ながら、抽出コード作成の時にそのやり方を実行した感じです。
現状では、HANAさまが仰っている内容がイメージできない状態なのですが、
この「抽出」を使えば、作業がはやくなりそうなことがいくつかあるので、
１つ１つ実践しつつ、なぜこうするのか？の部分を理解していきたいです。
（というか、トライ＆エラー型の人間なので、やってみるまで分からないタイプなんです(T_T)。）
＞ こんなコードだと、どうなるか 想像しながら いろんなセルをダブルクリックしてみてください。
→おぉ～。
指定した範囲にないセルは、＋になってダブルクリックしてもカーソルにならないですね。
シートを保護した際の、セルのロックと似ているように感じました。
＞調べもせずに、勝手な事を書いてますが。
→ほんとにたくさんの方が、同じような内容の質問を色々な処にしていらっしゃいました。
今のところ、15個ほど記事を見つけたので、それらを端から読んで
自分に応用できるものを探しています。
チェックボックスの作成に、フォームコントロールとアクティブXの2種類があることも知らなかったので
これまた、微妙なところでしょうけれど。
やりたいことが、「指定した行のチェックボックスをオフにする」という一文になる以上、
今回のように、複雑な手順(コード)にならないことを祈りつつ頑張りますｐ(^－^)ｑ。 （Machi)
＞フィルタオプションについて ＞現状では、HANAさまが仰っている内容がイメージできない状態なのですが、 そんなに大層な事ではなく、今は A1セルに「部署」A2セルに「部署名」を入れてますが 例えば、A1セルを「表示商品名」にしてA2セルに商品名を入れてマクロを実行すると 商品名での絞り込みが出来ますね。
で、この条件の範囲を A列じゃなくて K列から作ったとして K1セルに「部署」L1セルに「表示商品名」として 各2行目に 特定の部署と商品を入力。 条件範囲を K1:L2 にすると 部署＆商品 での絞り込みが行えます。
○○部署と××部署のデータを見たい とか 今はSheet1が一月に一シートですが これを一年で一シートにすると 上半期（○月～×月）の◇◇部署のデータを抽出 なんて事も 出来る様になるんじゃないかと思います。
そうすると、検索条件が二列とか三列とかになっちゃいますよね。 今は、A列の一列分しか条件を入力するところを取ってないので そういうの（複数列で絞り込み）を考えると 結果を表示するスペースの後ろ側とか また別のシートを新たに設けてとか まぁ、検索条件を入力する場所を変更して コードも変更して。。。。 なんて処置をとっておけば「ちょっと面倒なんだけど、こんなデータが欲しいんだけど」 と言われたとしても、余裕綽々です。(*｀ω´*)v まぁ、ご自身で使うなら マクロに拘らず メニューから実行すれば良いと思いますが。
オートフィルタもオプションを使えば一つの項目に対して条件が二つまで設定できますが 詳細設定の方が、その名の通り もう少し詳細に設定できますので。
＞この「抽出」を使えば、作業がはやくなりそうなことがいくつかあるので 別の所にも応用できそうなら、重ねて良かったです。 詳細設定は、今回使った方法が一番シンプルで 他にもいろいろな抽出が出来るので そういう事ならなおさら、習得してみてもらえると良いと思います。
個人的には、本を読むより 奮起→調べる→トライ→エラー→(´・ω・｀)→調べる→トライ が身に付くと思っていますので、程々で頑張ってください。
(HANA)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.