エクセルシ－トをグル－プ毎に表示させる

質問

お世話になります。
経営部門が、総務・技術・経理・管理・工場　と分別されており、一つのエクセルブックに現金預金・売掛金・支払利息など会計科目毎のシ－トを、総現金預金・技現金預金のように部門の頭文字一文字+会計科目名という形で作成保存しております。
現行はブックを開くと全ての部門での全ての会計科目シ－トが表示され目的の部門に帰属するシ－トを探すのが面倒なのと他の部門のシ－トも閲覧可能になってしまうという不具合が生じております。
エクセルのマクロで　部門略称（総・技・経・管・工）の目的部門名がシ－ト名の頭につけられている単独部門のみのシ－トを表示させるマクロ文と　逆に科目名指摘で全ての部門の当該科目シ－トのみを表示させるというマクロ文を　お教えください。

下記のように幾つか試行したのですが目的部門単体でのシ-ト表示は出来ませんでした。
If sht.Name <> activeSheetName Then sht.Visible = False
If sht.Name = ("総" & "*") Then sht.Visible = True

おんぶにだっこ状態で恥ずかしいのですが、部門に帰属する全てのシ－トの表示させるマクロ文と
任意の会計科目を構成する各部門の当該科目シ－ト全部を表示させることが出来るマクロ文とを
お教えください。

回答No.8

SI299792

前回のプログラムにバグがありました。修正版です。
'
Sub Macro3()
'　 ボタンを作る
　　Dim Sht As Object
　　Dim AText As Variant
　　Dim AName As Variant
　　Dim AAddress As Variant
　　Dim DeptCode As String
　　Dim IdX As Integer
　　Dim IdY As Integer
　　Dim ITop As Integer
　　Dim ILeft As Integer
　　Dim FullCode As String
'
　　Cells.RowHeight = 40　　'セルの高さ
　　Cells.ColumnWidth = 15　'セルの幅
'
　　For Each Sht In ActiveSheet.Shapes
　　　　If InStr(Sht.Name, "*") + InStr(Sht.Name, "?") > 0 Then
　　　　　　Sht.Delete
　　　　End If
　　Next Sht
'
　　AText = Array("全て", "総務", "技術", "経理", "管理", "工場")
　　AName = Array("*", "総*", "技*", "経*", "管*", "工*")
　　AAddress = Array("A2", "B2", "B3", "B4", "B5", "B6")

　　For IdX = 0 To 5
　　　　DeptCode = AAddress(IdX)
　　　　ITop = Range(DeptCode).Top
　　　　ILeft = Range(DeptCode).Left
　　　　ActiveSheet.Buttons.Add(ILeft, ITop, 60, 30).Select
　　　　Selection.Characters.Text = AText(IdX)
　　　　Selection.Name = AName(IdX)
　　　　Selection.OnAction = "Macro1"
　　Next IdX
'
　　FullCode = "次"
　　IdX = 3
　　IdY = 2
'
　　For Each Sht In Sheets
　　　　DeptCode = Mid(Sht.Name, 2)
'
　　　　If InStr(FullCode, DeptCode) = 0 Then
　　　　　　FullCode = FullCode & "," & DeptCode
　　　　　　ITop = Cells(IdY, IdX).Top
　　　　　　ILeft = Cells(IdY, IdX).Left
　　　　　　ActiveSheet.Buttons.Add(ILeft, ITop, 60, 30).Select
　　　　　　Selection.Characters.Text = DeptCode
　　　　　　Selection.Name = "?" & DeptCode
　　　　　　Selection.OnAction = "Macro1"
'
　　　　　　IdY = IdY + 1
　　　　　　If IdY > 9 Then　　 ' １列のボタン数+1
　　　　　　　　IdY = 2
　　　　　　　　IdX = IdX + 1
　　　　　　End If
　　　　End If
　　Next Sht
End Sub

お礼

幾度も御迷惑を掛ける形になりまして申し訳ございませんでした。
御指摘のように部門数は少ないのですが、勘定科目数が多いため難儀しております。
頂戴致しましたマクロ文とデ－タ－入力規則とで対処しようかと思います。
会計ソフト自体の機能も今一度見直しを致します。
１０月の新年度からは作業時間が大幅に短縮できそうです。
ありがとうございました。
拝

回答No.7

SI299792

いいこと考えた。ボタンをマクロで作ればいい。
変更があってもすぐに対応ができる。
目次というシートを作り、そこで実行してください。
'
Sub Macro3()
'　 ボタンを作る
　　Dim Sht As Object
　　Dim AText As Variant
　　Dim AName As Variant
　　Dim AAddress As Variant
　　Dim DeptCode As String
　　Dim IdX As Integer
　　Dim IdY As Integer
　　Dim ITop As Integer
　　Dim ILeft As Integer
　　Dim FullCode As String
'
　　Cells.RowHeight = 40　　'セルの高さ
　　Cells.ColumnWidth = 15　'セルの幅
'
　　For Each Sht In ActiveSheet.Shapes
　　　　If InStr(Sht.Name, "*") + InStr(Sht.Name, "?") > 0 Then
　　　　　　Sht.Delete
　　　　End If
　　Next Sht
'
　　AText = Array("全て", "総務", "技術", "経理", "管理", "工場")
　　AName = Array("*", "総*", "技*", "経*", "管*", "工*")
　　AAddress = Array("A2", "B2", "B3", "B4", "B5", "B6")
'
　　For IdX = 0 To 5
　　　　DeptCode = AAddress(IdX)
　　　　ITop = Range(DeptCode).Top
　　　　ILeft = Range(DeptCode).Left
　　　　ActiveSheet.Buttons.Add(ILeft, ITop, 60, 30).Select
　　　　Selection.Characters.Text = AText(IdX)
　　　　Selection.Name = AName(IdX)
　　　　Selection.OnAction = "Macro1"
　　Next IdX
'
　　FullCode = "次"
　　IdX = 3
　　IdY = 2
'
　　For Each Sht In Sheets
　　　　DeptCode = Mid(Sht.Name, 2)
'
　　　　If InStr(FullCode, DeptCode) = 0 Then
　　　　　　FullCode = FullCode & "," & DeptCode
　　　　　　ActiveSheet.Buttons.Add(ILeft, ITop, 60, 30).Select
　　　　　　ITop = Cells(IdY, IdX).Top
　　　　　　ILeft = Cells(IdY, IdX).Left
　　　　　　Selection.Characters.Text = DeptCode
　　　　　　Selection.Name = "?" & DeptCode
　　　　　　Selection.OnAction = "Macro1"
'
　　　　　　IdY = IdY + 1
　　　　　　If IdY > 9 Then　　 ' １列のボタン数+1
　　　　　　　　IdY = 2
　　　　　　　　IdX = IdX + 1
　　　　　　End If
　　　　End If
　　Next Sht
End Sub

回答No.6

noname#231195

#2です。

インターフェースを工夫するのが面倒くさい場合、私はインプットボックスをそのまま使ってこんな風にしています。

Select InputBox (_
"Dept Code?" & vbCrLf &_
"1. 総務" & vbCrLf &_
"2 技術" & vbCrLf &_
"3. 経理" & vbCrLf &_
"4. 管理" & vbCrLf &_
"5. 工場")
Case 1
DeptCode = "総"
Case 2
DeptCode = "技"
.............
End Select

このインプットボックスを実行するとこんな風になります。
Dept Code?
1. 総務
2 技術
3. 経理
4. 管理
5. 工場

20以上あくとちょっと多いかもしれませんが、インターフェースのページを作るのと、インプットボックスをだらだら書くか、どっちが楽に感じられるか、って選択でしょうね。

まぁ、私は手元で自分のコード走らせてみましたから、このコードが走ることは私は分かっています。だから、新しいインターフェース作ってまたパグ取りするより、インプットボックスいじる方が心理的には楽です。

インターフェースのページはまた、そのうち気が向いたときに、ってことにするかな(^^ゞ

お礼

お世話になります。
会計ソフト自体の機能を今一度見直ししてみます。
御指摘のように会計科目数自体が多いので極力手入力作業を排除したいと思っています。
インプットボックス方式とデ－タ－入力規則との併用で可能かなとの印象でございます。
本当に多々御世話になり感謝の言葉が見つかりません。
新年度の１０月月次締め作業に間に合うように頑張ってみます。
色々と本当にありがとうございました。
御体調崩されませんようにと願っております。
拝

回答No.5

SI299792

訂正です。
前回の方法は、科目名に、総・技・経・管・工のどれかで始まる又は終わるものがあれば誤動作します。
また、変数の定義を忘れていました。
ボタン名に* が可能ということが判ったので、これを利用します。
(1)目次というシートを作る。
(2)全てというボタンを作り名前を* にする。
(3)総務・技術・経理・管理・工場のボタンを作り、名前を 総務なら総* にする
(4)科目名のボタンを作り、名前を ?科目名にする。
'
Option Explicit
'
Sub Macro1()
'
　　Dim Sht As Worksheet
'
　　For Each Sht In Sheets
　　　　Sht.Visible = True
'
　　　　If Sht.Name <> "目次" And Not Sht.Name Like Application.Caller Then
　　　　　　Sht.Visible = False
　　　　End If
　　Next Sht
'
End Sub

もう１つ方法を考えました
目次というシートを作る。
A1に　「選択したい項目にカーソルを合わせてクリックし、マクロ実行ボタンを押してください」
A3に　「全て」
B3に　「*」
C3から「総務」…
D3から「=LEFT(C3,1)&"*"」…
E3から　科目名を順に入力
F3から「="?"&E3」…
B,D,F を非表示にする
上のマクロのIfを変更する
　　　　If Sht.Name <> "目次" And Not Sht.Name Like ActiveCell.Offset(0, 1) Then
これは、ボタンを作る手間が省ける・科目の変更があってもボタンの変更が不要というメリットがあります。一方で、ユーザーに使い方がわかりにくいというデメリットもあります。

他にもリストボックスを使うなど手段が考えられます。

回答No.4

SI299792

InputBoxを使う方法はユーザーがその都度入力するので使い勝手が悪いと思います。
次のような方法はいかがでしょうか。
目次というシートを作る。
そのシートに、総務・技術・経理・管理・工場と科目名のボタンを配置
全てのボタンに名前を付ける、例えば総務だったら、「総」のように選択したい文字を名前にする。
全てを表示するボタンを作りALL という名前を付ける。
全てのボタンにから、以下のマクロを呼び出す。
'
Sub Macro1()
'
　　For Each sht In Sheets
　　　　sht.Visible = True
'
　　　　If sht.Name <> "目次" And Application.Caller <> "ALL" And Not sht.Name Like Application.Caller & "*" And Not sht.Name Like "*" & Application.Caller Then
　　　　　　sht.Visible = False
　　　　End If
　　Next sht
'
End Sub

この方法ならユーザーが入力する必要がありません。

参考URL：

http://www.k1simplify.com/vba/tipsleaf/callbuttonname.html

回答No.3

noname#231195

#2です。

かぶった。
でも#1さんのコードみて少し改良しました。
最初の私のコードではFor Each Nextをわざわざ2回回しているので、そこを変えました。

Sub DeptSelect()
Dim Sht As Object
Dim DeptCode As String
Application.ScreenUpdating = False
DeptCode = InputBox("Department Code?")
For Each Sht In ActiveWorkbook.Sheets
With Sht
.Visible = True
If Left(.Name, 1) <> DeptCode Then
.Visible = False
End If
End With
Next
Application.ScreenUpdating = True
End Sub

Sub ItemSelect()
Dim Sht As Object
Dim ItemCode As String
Application.ScreenUpdating = False
ItemCode = InputBox("Item Code?")
For Each Sht In ActiveWorkbook.Sheets
With Sht
.Visible = True
If Mid(.Name, 2) <> ItemCode Then
.Visible = False
End If
End With
Next
Application.ScreenUpdating = True
End Sub

お礼

いつも早々に御教授下さいまして本当にありがとうございます。
御陰様で社内業務順調に慮外の短時間で処理させていただいております。
以前頂戴致しました御回答について補足（記載質問個所の不明瞭文訂正など）を行いましたら、お礼入力欄が
表示されませんでしたので欠礼の段たいへん申し訳ございませんでした。お許しください。
頂戴致しました御回答申し訳ないのですが、明日帰宅致しましたら試行させてください。
重ね書きになりまして恐縮ですが、早朝深夜に拘わらず御回答を頂戴するので、睡眠時間は？と懸念しております。どうぞ御体調崩されませんようにと本当に心配しております。
部署は５個所なのですが、勘定科目名称は２０以上でございますので、勘定科目名指定からの表示につきましては頂戴致しましたマクロ文熟読させていただき試行してみます。
初心者にとっていつも優しい文章で的確な目的達成文章をいただけますので本当に感謝しております。
ありがとうございました。

回答No.2

noname#231195

>他の部門のシ－トも閲覧可能になってしまうという不具合
でも、お示しになられたコードでは、VisibleプロパティをFalseにしているだけですから、隠しても手動でVisibleにしてみることができますが、それはそういう仕様でいいんですね？

>単独部門のみのシ－トを表示させるマクロ文
Sub DeptSelect()
Dim Sht As Object
Dim DeptCode As String
Application.ScreenUpdating = False
DeptCode = InputBox("Department Code?")
For Each Sht In ActiveWorkbook.Sheets
Sht.Visible = True
Next
For Each Sht In ActiveWorkbook.Sheets
With Sht
If Left(.Name, 1) <> DeptCode Then
.Visible = False
End If
End With
Next
Application.ScreenUpdating = True
End Sub

>科目名指摘で全ての部門の当該科目シ－トのみを表示させるというマクロ文
Sub ItemSelect()
Dim Sht As Object
Dim ItemCode As String
Application.ScreenUpdating = False
ItemCode = InputBox("Item Code?")
For Each Sht In ActiveWorkbook.Sheets
Sht.Visible = True
Next
For Each Sht In ActiveWorkbook.Sheets
With Sht
If Mid(.Name, 2) <> ItemCode Then
.Visible = False
End If
End With
Next
Application.ScreenUpdating = True
End Sub

部門略称や科目名はインプットボックスに手で書き込む仕様です。
部門名略称は一文字ですからなんてことはないでしょうが、科目名は「支払利息」とか長いので入力するのが面倒かもしれません。

回答No.1

SI299792

多分samchan さんのやりたいことは、このようなことだと思います。
'
Sub Macro1()
'
　　For Each sht In Sheets
　　　　sht.Visible = True
'
　　　　If Not sht.Name Like "総*" Then
　　　　　　sht.Visible = False
　　　　End If
　　Next sht
'
End Sub

* を使うときは= ではなくLikeを使います。否定の時は頭にNot を付けます。

しかし、科目にはどのようなものがあるのか、部門や科目をどのように選択するか書いてありません。
部門５つと、科目すべてのボタンを作るのか。
ユーザーフォームを使うのか。
オプションボタンを使うのか。
それによって、プログラムが変わりますので、現段階ではこれ以上答えられません。

お礼

深夜にも拘わらず早々に御教授いただきまして本当にありがとうございました。
御陰様で部門別のシ－トを「平易なマクロ文で容易に目的を達成できました」ビックリです。
科目については決算書表示科目ですので御指摘のように２０項目以上ございます。
御指摘のようにユ－ザ－フォ－ムなどの形式を考案してチャレンジしてみます。
"総*"の個所を*印の位置を前方に持ってきて科目名称にセル位置を置いて試行してみます。
重ね言葉で恐縮でございますが、本当にありがとうございました。
拝

失礼な加筆をお許しください。
インストラクタ－の皆様ってチャント睡眠時間を取っていらっしゃるのでしょうか？
どうぞ御体調崩されませんように御願いいたします。