エクセルVBAで

質問

1シート1得意先で得意先別に売上を管理するエクセルシートがあり、一枚目には得意先全体の売上を合計しているシートがあります。得意先別のシート名は得意先コードと得意先名になっており、期を更新する際に、得意先数分のシートを手動でグループ化させてから期を更新するマクロを実行するようにしていますが、これをVBAで自動処理させたいのです。
ただ、実際には得意先欄開始というシートと得意先欄終了というシートの間に得意先別のシートがあり、得意先数は増えたり減ったりもしますので、シート名でグループ化を指示することが出来ません。得意先欄開始～得意先欄終了までの間のシートすべてをグループ化させるようにしたいのです。
可能でしょうか？

回答No.3

Wendy02 · ベストアンサー

グループ化というのは、シートの[作業グループ]のことですね。

得意先欄開始～得意先欄終了　の間のシートを選択するようにできています。
[得意先欄開始/得意先欄終了]自体は含めません。なお、シートの数は関係ありません。
ただ、万が一、「得意先欄終了/得意先欄開始」と逆になっていたときは、得意先欄開始から最後まで選択されます。

Sub SelectingSheets()
　Dim Flg As Boolean
　Dim ShNames() As Variant
　Dim i As Long, j As Long
　Const First As String = "得意先欄開始"
　Const Last As String = "得意先欄終了"
　For i = 1 To Worksheets.Count
　　If Worksheets(i).Name = First Then
　　　Flg = True
　　ElseIf Worksheets(i).Name = Last Then
　　　Flg = False
　　End If
　　If Flg = True And Worksheets(i).Name <> First Then
　　　ReDim Preserve ShNames(j)
　　　ShNames(j) = Worksheets(i).Name
　　　j = j + 1
　　End If
　Next
　Worksheets(ShNames).Select
　'Call 処理マクロ
End Sub

お礼

ご回答感謝します。
出来ました。
実はこのシートは前回ご回答いただいたもの（エクセルVBAユーザーフォームのテキストボックスについて）と同じシートなんです。
おかげ様で仕事が早く済みそうです。
有難うございました。

回答No.4

taocat

こんばんは。
既に回答は出てますが、参考までに。

得意先開始・終了シートはその順番で存在し、
かつ、その間に得意先シートが一つ以上あるものとする

-----------------------------------------------
Sub Test222()

　Dim StartIdx As Integer
　Dim EndIdx As Integer
　Dim S As Integer
　Dim mySht

　StartIdx = Worksheets("得意先開始").Index
　EndIdx = Worksheets("得意先終了").Index

　For S = StartIdx + 1 To EndIdx - 1
　　　mySht = mySht & Worksheets(S).Name & ","
　Next S

　mySht = Split(Left(mySht, Len(mySht) - 1), ",")
　Worksheets(mySht).Select

　　　'●更新処理●

End Sub
-------------------------------------------------

それから、
１．開始・終了シートの両方、又は片方がない
２．開始・終了シートの順番が逆
３．開始・終了シートの間に得意先シートが一つもない

このような場合、エラーメッセージを表示し終了するコード。

-------------------------------------------------
Sub Test333()

　Dim StartIdx As Integer
　Dim EndIdx As Integer
　Dim S As Integer
　Dim mySht

　On Error GoTo ErrRtn

　StartIdx = Worksheets("得意先開始").Index
　EndIdx = Worksheets("得意先終了").Index

　For S = StartIdx + 1 To EndIdx - 1
　　　mySht = mySht & Worksheets(S).Name & ","
　Next S

　If mySht = Empty Then
　　　MsgBox "開始・終了シートの順番が逆か" & Chr(13) _
　　　　　& "開始・終了シートの間に得意先シートがありません"
　Else
　　　mySht = Split(Left(mySht, Len(myS　ht) - 1), ",")
　　　Worksheets(mySht).Select

　　　　　'●更新処理●
　End If
Exit Sub

ErrRtn:
　　MsgBox "開始・終了シートの両方、又は片方がありません"
End Sub
----------------------------------------------

他の人に使わせる場合はエラーチェックを入れることをお薦めします。
以上です。

お礼

ご回答有難うございます。
エラーチェックの件参考になります。
VBAは超初心者ですので、いろいろいじくりながら勉強しているところですが、奥が深いです。
有難うございました。

回答No.2

HAL2010

ソース上めんどくさいので（ぉぃ！）、１０シート分しか対応していませんが＾＾；
なお、得意先欄開始～得意先欄終了の間にシートがなかった場合は考慮していません。（たぶん選択時にシステムエラーが出ます）

ネスト全角にすると反対に見にくかったので、べたで＾＾；

Private Sub Kekkou_Mendou()
Dim intCnt As Integer
Dim strStName(10) As String
Dim intI As Integer
Dim intStart As Integer
Dim intEnd As Integer
Dim intStNum(10) As Integer

intCnt = 1
'全シート名取得
For Each MySheets In ActiveWorkbook.Sheets
If intCnt > 10 Then
MsgBox "処理シート数が処理上限を超えました。管理者に連絡してください"
Exit Sub

End If

strStName(intCnt) = Worksheets(intCnt).Name
intCnt = intCnt + 1
Next

'1シート目は確実に違うのでスキップして２シート目から処理
For intI = 2 To intCnt - 1
If strStName(intI) <> "得意先欄開始" And _
strStName(intI) <> "得意先欄終了" Then

If intStNum(1) = 0 Then
For intJ = 1 To 10
'選択シート番号の初期値として、最初の対象シート番号を
'設定する。（選択時、同一番号が複数でもエラーは出ない）
intStNum(intJ) = intI

Next intJ
intJ = 1

End If

intStNum(intJ) = intI
intJ = intJ + 1

ElseIf strStName(intI) = "得意先欄終了" Then
Exit For

End If

Next

'複数シートを選択
Sheets(Array(intStNum(1), intStNum(2), intStNum(3), _
intStNum(4), intStNum(5), intStNum(6), _
intStNum(7), intStNum(8), intStNum(9), _
intStNum(10))).Select

End Sub

お礼

再度のご回答感謝します。
有難うございました。

回答No.1

HAL2010

完全ではありませんが＾＾；
更新処理を実行とコメントのある場所で更新処理に関する記述をすれば、１シートずつなら処理できます。
…もう少し考えてみます。
なお、見栄え（ネスト）の都合から半角スペースを全角に変換してあります。

Private　Sub　Kekkou_Mendou()
Dim　intCnt　As　Integer
Dim　strStName(255)　As　String
Dim　intI　As　Integer

intCnt　=　1
'全シート名取得
For　Each　MySheets　In　ActiveWorkbook.Sheets
　　　　strStName(intCnt)　=　Worksheets(intCnt).Name
　　　　intCnt　=　intCnt　+　1
Next

'1シート目は確実に違うのでスキップして２シート目から処理
For　intI　=　2　To　intCnt　-　1
　　　　If　strStName(intI)　<>　"得意先欄開始"　And　_
　　　　　　　strStName(intI)　<>　"得意先欄終了"　Then
　　　　　　　　'更新処理を実行

　　　　ElseIf　strStName(intI)　=　"得意先欄終了"　Then
　　　　　　　　Exit　For

　　　　End　If

Next

End　Sub

お礼

ご回答感謝します。
VBA超初心者なのでゆっくりとしか理解できませんが、大変参考になります。
ありがとうございました。