配列に使うＡｒｒｙ関数について

質問

winXP Excel2003でマクロ作成している初心者です。
１）指定した４個のシート以外を選択するコードを教えていただきました。
　これを利用して
list = Array("ＡＡＡ会社", "ＢＢＢ会社", "ＣＣＣ会社", "ＤＤＤ会社", "ＥＥＥ会社", ・・以下略") の
部分を手修正でなく、追加削除にも対応できるように指定シート以外を選択したいのですがうまくいきません。
どうかお助けください。
ーーーーーーーーーーーーーーーーーーーーーーーーーーー
教えていただいたコード

Sub 請求書入力()
　　' // 処理を除外するシート名リスト
　　Const EXCEPT_NAME = "集計用 印刷用 リンク用 会社見本"

　　Dim sh As Worksheet
　　For Each sh In ThisWorkbook.Worksheets
　　　　If InStr(EXCEPT_NAME, sh.Name) = 0 Then
　　　　　　sh.Activate
　　　　　　Call 請求書作成用部品
　　　　End If
　　Next
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー
現在のマクロコード

Sub 請求一覧表作成()
Application.ScreenUpdating = False

ChDrive ThisWorkbook.Path
ChDir ThisWorkbook.Path

Call BookOpen("請求書入力.xls")
Dim list, SheetName
Sheets("請求一覧表").Select

Range("A4:U15").Select
Selection.ClearContents

Range("A4").Select
list = Array("ＡＡＡ会社", "ＢＢＢ会社", "ＣＣＣ会社", "ＤＤＤ会社", "ＥＥＥ会社", ・・以下略")
↑この部分はシートの追加・削除の度に手修正している。

For Each SheetName In list
Sheets(SheetName).Activate

Call 配列
Next
Worksheets("請求一覧表").Activate
ActiveSheet.Protect
End Sub
ーーーーーーーーーーーーーーーーーーーーーーー
Sub 配列()

With ActiveSheet
' 配列に格納 --

Dim i As Integer
Dim LastRow As Long
Dim SaleAry As Variant

' 配列に格納 --

SaleAry = Array(.Range("C8"), .Range("D13"), .ange("T30")・・・以下略))

End With
' 転記 ---

With Worksheets("請求一覧表")

LastRow = .Range("A65536").End(xlUp).Row
For i = 0 To UBound(SaleAry)
.Cells(LastRow + 1, i + 1).Value = SaleAry(i)
Next i
End With
Set SaleAry = Nothing
End Sub

回答No.2

kenpon24 · ベストアンサー

Const EXCEPT_NAME = "集計用 印刷用 リンク用 会社見本"
をグローバルにして、

list = Array("ＡＡＡ会社", "ＢＢＢ会社", "ＣＣＣ会社", "ＤＤＤ会社", "ＥＥＥ会社", ・・以下略")
を削除して、

配列ルーチンを呼ぶループを
For Each SheetName In ThisWorkbook.Worksheets
If InStr(EXCEPT_NAME, SheetName.Name) = 0 Then
Sheets(SheetName).Activate
Call 配列
End If
Next

とするではダメなんでしょうか。

補足

Const EXCEPT_NAME = "集計用 印刷用 リンク用 会社見本"
をグローバルにして、-----と書いてありますが具体的にどうすればよろしいでしょうか？　すいません。

回答No.12

kenpon24

Sheets(SheetName.Name).Activateは
SheetName.Activateでもよかったな。っと。

ああ、そうか。
("ＡＡＡ会社", "ＢＢＢ会社", "ＣＣＣ会社", "ＤＤＤ会社", "ＥＥＥ会社"...は別のブックのシートなのか。

For Each SheetName In ThisWorkbook.Worksheets
を
For Each SheetName In ActiveWorkbook.Worksheets
としたら動きますか？

お礼

ありがとうございました。できました！長い道のりで、もうあきらめようかと思っていました。感謝感激です。わずらわしい私の疑問を解決していただき喜びでいっぱいです。

回答No.11

kenpon24

No.7に対する返信です。

Sheets(SheetName).Activate　←----この行が黄色になり　「実行時エラー13　型が一致しません」のエラーが表示されます。

すみません。ミスってました。
Sheets(SheetName.Name).Activate

ってしてください

補足

kenpon24さま　お世話になります。
今修正して実行したところ、今度は
実行時エラー9　インデックスが有効範囲にありません。」という表示になります。再三もうしわけありません。

回答No.10

kenpon24

そのエラーを回避するだけなら、これでいけるか・・・？
他でエラーするかどうか知りませんけど

　　Set wb = Workbooks.Open(ThisWorkbook.Path & "\Aフォルダ\請求書入力.xls")
　　wb.activate

　　Set shList = wb.Sheets("請求一覧表")

　　' // 転記先シートの初期化
　　With shList
.Select
　　　　.Unprotect
　　　　.Range("A4:U15").ClearContents
　　　　.Range("A4").Select
　　End With

回答No.9

KenKen_SP

大切な部分の説明が足りないのではないですか？

　　1.　Ａブック
　　2.　請求書入力.xls

があるわけですよね？ それで、

　　A)　集計用 印刷用 リンク用 会社見本の各シート
　　B)　請求一覧表シート
　　C)　ＡＡＡ会社, ＢＢＢ会社...等の各シート

はそれぞれ、先述の 1 or 2 のどのブックに属しているのですか？
この点をはっきりさせないと、回答するにしても混乱ばかりで問題点
を絞りきれないと思います。

　　前提：
　　Ａブック　　　　--　マクロのみ
　　請求書入力.xls　--　A～C のシート全て

という構成なら、下記でどうですか？

' // Ａブックの標準モジュール

'　// 請求書入力.xls において転記処理を除外するシート名リスト
Public Const EXCEPT_NAME = "請求一覧表 集計用 印刷用 リンク用 会社見本"

Sub 請求一覧表作成()

　　Dim wb　　 As Workbook　' // 請求書入力.xls
　　Dim shList As Worksheet ' // 請求書入力.xls - 請求一覧表
　　Dim sh　　 As Worksheet ' // 請求書入力.xls の各シートループ用
　　Dim i　　　As Long　　　' // 行カウンタは Integer ではダメ

　　' // 画面描写停止は、デバッグが終了してから
　　' Application.ScreenUpdating = False

　　Set wb = Workbooks.Open(ThisWorkbook.Path & "\請求書入力.xls")
　　Set shList = wb.Sheets("請求一覧表")

　　' // 転記先シートの初期化
　　With shList
　　　　.Unprotect
　　　　.Range("A4:U15").ClearContents
　　　　wb.Activate
　　　　.Range("A4").Select
　　End With

　　' // 転記先行番号を求める
　　i = shList.Cells(shList.Rows.Count, "A").Row + 1

　　' // 請求書入力.xls (=変数 wb) の各シートを走査
　　For Each sh In wb.Worksheets
　　　　' // 処理除外シートでなければ転記処理を行う
　　　　If InStr(EXCEPT_NAME, sh.Name) = 0 Then
　　　　　　' // 配列による一括転記をしないなら、以下のように
　　　　　　' // 書いても同じこと。むしろこの方が理解し易い
　　　　　　shList.Cells(i, "A").Value = sh.Cells(8, "C").Value
　　　　　　shList.Cells(i, "B").Value = sh.Cells(13, "D").Value
　　　　　　shList.Cells(i, "C").Value = sh.Cells(30, "T").Value
　　　　　　' // 以下略
　　　　　　i = i + 1 ' // 最大行数の制限によるエラーの可能性あり
　　　　End If
　　Next

　　shList.Protect

　　Set shList = Nothing
　　Set wb = Nothing

End Sub

それから失礼を承知の上で、アドバイス申し上げますが・・

1.　Call BookOpen("請求書入力.xls")
　　単に Workbooks.Open("請求書入力.xls") で良いのでは？
　　わざわざ自作ルーチンを用意している理由は？
　　その内容は、コードを掲載するか、コメントで補足しないと回答者
　　にはわかりません。

2.　処理の過細分化
　　処理のまとまりごとにサブルーチン化する考えはとても良いと思います。
　　しかし、今回のご質問については、細分化しすぎてコードを複雑にして
　　いる気がします。もっと大きな処理ブロックで考えてみて下さい。

3.　配列の使用
　　転記スピード等を考慮している様子ではないし、無理に配列を使う理由
　　はないと思いますが...
　　一般に配列を使ったコードの可読性は悪くなりがちです。
　　大量データ（数千～数万規模）を扱うか、コンマ何秒の高速化が必要な
　　場面以外ではセルを配列に置き換えるメリットはほとんどありません。
　　メリットが少ないのならコードの可読性を優先した方が無難です。

ご参考までに。頑張ってください。

補足

使っているD社のPCをビスタＳＰ1にアップしようとしたところ内部エラーが発生。サポートが原因不明だから送ってくださいといわれ、やっと2週間で戻ってきました。ためにNETに接続できまず、ご回答いただいた方々に誠に申し訳なくひれ伏してお詫びします。
--大切な部分の説明が足りない---すいません。他の質問で詳細に書いたところ、質問がながすぎて意味不明・・といわれたことがあり・・

1個の業務用フォルダがあり、その中に「表紙.xls 」「Aフォルダ」「Bフォルダ」「Cフォルダ」・・・があります。
「Aフォルダ」の中に「請求書入力.xls 」があります。
　「請求書入力.xls 」の中には次のシートがあります。
　　A)　請求一覧表 印刷用 リンク用 会社見本の各シート
　　B)　ＡＡＡ会社, ＢＢＢ会社...等の各シート
　B)の会社名シートは、変更や削除が不定期にあるため最新のものを利用したい。

「表紙.xls 」のコマンドボタンから「Aフォルダの請求書入力.xls」に飛び、ご指導いただいたコードを実行したところ、「請求書入力.xlsがみつかりません」のエラーがでました。そこで最上位ホルダである
業務用フォルダに複写しました。すると今度は .Range("A4").Selectのところで「Rangeクラスのselectメソッドが失敗しました。」のエラーになります。
---　Call BookOpen("請求書入力.xls")
　　単に Workbooks.Open("請求書入力.xls") で良いのでは？以前そうしていたところ、開いているところに開くとエラーになるため、困っていたらここで以下のコードを教えてもらいました。

Sub BookOpen(WB_name As String)
Dim wb As Workbook
Dim FLG As Boolean

FLG = False
For Each wb In Workbooks
If wb.Name = WB_name Then
FLG = True
Exit For
End If
Next

If FLG = False Then
'WB_name で指定されたブックが開いていない場合は開く。
Workbooks.Open Filename:=ThisWorkbook.Path & "\Ａグループ請求\" & WB_name
End If
End Sub
転記スピード等を考慮している様子ではないし、無理に配列を使う理由　　はないと思いますが...
そこまで考えませんでした。ただ単にかっこいいコードということと、めったに配列の変更はしないことと、わりと変更しやすい。という単純な理由からでした。

回答No.8

pulsa

list = Range("A1:A20") 'listはVariantで宣言

こんな書き方も出来ます
list(i)では無くlist(i,1)ってな書き方になりますが、配列の内容を外に置いて使うにはもってこいですし、何よりCells(10,1)って書くのと同じ形式なので、扱いが楽です
しかも
For Each SheetName In list
Sheets(SheetName).Activate

Call 配列
Next SheetName
とやるなら、このままで動作します

って事は、つまり
For Each SheetName In list
は
For Each SheetName In Range("A1:A20")
でもOKって事です
ループのMaxに指定する最終行が取得できるようなので、例にしたA20をそれと入れ替えて
For Each SheetName In Range("A1:A" & LastRow)
なんてやれば、ちょいとオシャレ（？）です

どうしても
list(i)　にしたいのであれば
ReDim list(0)
For Each SheetName In Range("A1:A" & LastRow)
　　ReDim Preserve list(i)
　　list(i)　= Range("A" & i + 1)
　　i = i + 1
・
・
で行けます

個人的には、素人の方が使う為との事なので、むしろ空欄入れた時どうするかとか、全部空欄だったらなどのエラー処理の方がメンドイ気が…＾＾；

回答No.7

kenpon24

ようやく実行してみたけど動かなかった・・・て、
配列ルーチンが単体でうまく動くかってテストしてます？

それと、請求一覧表作成ルーチンの最後で
ActiveSheet.Protect
ってやってるけど、ちゃんと入力前にUnprotectしてますよ・・・ね？

補足

使っているD社のPCをビスタＳＰ1にアップしようとしたところ内部エラーが発生。サポートが原因不明だから送ってくださいといわれ、やっと2週間で戻ってきました。ためにNETに接続できまず、ご回答いただいた方々に誠に申し訳なくひれ伏してお詫びします。次のコードを実行したところ、エラーが発生します。何が原因かよくわからないのですが・・。あと一歩で出来そうな気がします。よろしくお願いします。
Sub 請求一覧表作成()
'シートが保護されていたら保護を解除
If ActiveSheet.ProtectContents = True Then
ActiveSheet.Unprotect
End If
ChDrive ThisWorkbook.Path
　ChDir ThisWorkbook.Path
Workbooks.Open(ThisWorkbook.Path & "\Ａフォルダ\請求書入力.xls")
Dim list, SheetName
Sheets("請求一覧表").Select
'シートが保護されていたら保護を解除
If ActiveSheet.ProtectContents = True Then
ActiveSheet.Unprotect
End If
Range("A4:U15").Select
Selection.ClearContents
Range("A4").Select
For Each SheetName In ThisWorkbook.Worksheets
If InStr(EXCEPT_NAME, SheetName.Name) = 0 Then
Sheets(SheetName).Activate　←----この行が黄色になり　「実行時エラー13　型が一致しません」のエラーが表示されます。
Call 配列
End If
Next
Worksheets("請求一覧表").Activate 'シートをアクティブに
ActiveSheet.Protect
End Sub

回答No.6

kenpon24

ああ、グローバルの意味がわかりませんでしたか。
すみませんでした。

簡単に言うと、請求書入力ルーチンにある
Const EXCEPT_NAME = "集計用 印刷用 リンク用 会社見本"
を関数の外に出してしまえば、他の関数でも利用できるってことです。
請求一覧表作成でもEXCEPT_NAMEを宣言すればいいのですが、
同じ内容はできるだけ使いまわした方が保守性の面から言って楽です。
(まさに、今回の話題は保守性の話ですし)

ただグローバルにした場合、他の関数でEXCEPT_NAMEをまったく別の用途で
使っているときに悪影響を及ぼします。
故にNo.5さんは他のEXCEPT_NAMEを宣言していれば消せ。と書いたのです。

以上、グローバルの話。

で、どうしても
list = Array("ＡＡＡ会社", "ＢＢＢ会社", "ＣＣＣ会社", "ＤＤＤ会社", "ＥＥＥ会社", ・・以下略")
のような書き方をしたい。そこを楽したいんだというのであれば(私としてはお勧めしませんが)、
list=(～を自動で作成してシートの適当な場所に格納し、
そこから手作業でVBEにコピペするってもできます。

Sub test()
Dim ws As Worksheet
Dim st As String

st = "list = Array("
For Each ws In ActiveWorkbook.Worksheets
st = st & Chr(&H22) & ws.Name & Chr(&H22) & ","
Next

'最後の,を消して)を付ける
st = Left(st, Len(st) - 1) & ")"

Range("A1") = st
End Sub

補足

実はこの請求マクロプログラムはマクロについてまったくの素人の知人に頼まれ作成しました。私が居なくとも自分で会社名の削除や追加ができるようにしてあげたいので、改造を試みています。という私自身も超初心者なんですが・・。なので「手作業でVBEにコピペ」は無理なんです。

回答No.5

onlyrom

＞Const EXCEPT_NAME = "集計用 印刷用 リンク用 会社見本"
＞をグローバルにして、

グローバルにするとは、
標準モジュールの宣言セクションに、Publicステートメントで宣言するということです。

現在の使用中の標準モジュールの宣言セクションでもいいですが、
新たに標準モジュールを追加して、そこで宣言してもＯＫ。

例えば、現在、標準モジュールとして、Module1,Module2を使っている場合。

新たに標準モジュールを挿入するとModule３が出来るのでそこに

Public Const EXCEPT_NAME = "集計用 印刷用 リンク用 会社見本"

と書くだけです。

他のモジュールで、Publicなしで
Const EXCEPT_NAME = "集計用 印刷用 リンク用 会社見本"
と宣言していたら、それらは全て削除しておきます。
（別に削除しなくてもいいが、間違いの原因になる）

そうしておいて、Ｎｏ２の回答を利用する。

以上。

補足

わかりやすい説明ありがとうございます。今やっとこのコードを実行しました。ところが、一覧表を見ると各会社シートのデータが何も表示されていません。狐につままれた・・・です。原因を追求しましたが、現時点では不明です。

回答No.4

n-jun

>Ａブックには他に見積作成ブックとか多くの他の業務に飛ぶコマンドボタンがあり、すべてＡブックに
>プロシージャが書かれています。
>ところが、この請求書作成ブックには次のコードがありますので
Ａブックのシートを追加・削除した時に、請求書作成ブックの
>list = Array("ＡＡＡ会社", "ＢＢＢ会社", "ＣＣＣ会社", "ＤＤＤ会社", "ＥＥＥ会社", ・・以下略")
を都度手直ししなければ、と言う事のようですね。

でも、
>視覚的にすぐわかりやすいので、できればこいうコード
を希望されているのなら、
>list = Array("ＡＡＡ会社", "ＢＢＢ会社", "ＣＣＣ会社", "ＤＤＤ会社", "ＥＥＥ会社", ・・以下略") の部分を手修正
は避けようがないのかな？

と言うかコードにそれが必要なのでしょうか？
例えば、Ａブックのシート名をメッセージボックスとかで画面に出せば
作業を行なう会社名はその都度わかりますけど。
追加・削除のたびにコードに表示しないといけないのなら、
他の回答をお待ち願います。

回答No.3

end-u

>list = Array("ＡＡＡ会社", "ＢＢＢ会社", "ＣＣＣ会社", "ＤＤＤ会社", "ＥＥＥ会社", ・・以下略")
>↑この部分はシートの追加・削除の度に手修正している。
>...手修正でなく、追加削除にも対応できるように指定シート以外を選択したい
コードの中にシート名を埋め込むのではなく、処理対象外シートを選択式にしたいという意味でしょうか？

Sub try1() '対象【外】シートを選択して実行。
　　Dim shs As Sheets
　　Dim ws　As Worksheet
　　Dim s　 As String
　　Dim i　 As Long

　　With ThisWorkbook
　　　　Set shs = .Windows(1).SelectedSheets
　　　　.Sheets(1).Select
　　　　ReDim x(1 To shs.Count)
　　　　For i = 1 To shs.Count
　　　　　　x(i) = shs(i).Name
　　　　Next
　　　　s = Join(x) '対象外シート結合文字列
　　　　Debug.Print s
　　　　For Each ws In .Worksheets
　　　　　　If InStr(s, ws.Name) = 0 Then
　　　　　　　　Debug.Print ws.Name '対象シート
　　　　　　End If
　　　　Next
　　End With
　　Set shs = Nothing
End Sub

処理シートのほうが少なければ、それを選択して実行したほうが良いかもしれませんね。

Sub try2() '【対象】シートを選択して実行。
　　Dim shs As Sheets
　　Dim sh　As Object

　　With ThisWorkbook
　　　　Set shs = .Windows(1).SelectedSheets
　　　　.Sheets(1).Select
　　　　For Each sh In shs
　　　　　　Debug.Print sh.Name
　　　　Next
　　End With

　　Set shs = Nothing
End Sub

補足

コードの中にシート名を埋め込むのではなく、処理対象外シートを選択式にしたいという意味でしょうか？

　' // 処理を除外するシート名リスト
　　Const EXCEPT_NAME = "集計用 印刷用 リンク用 会社見本"
上の例のように視覚的にすぐわかりやすいので、できればこいうコードが
いいのですが、
list = Array("ＡＡＡ会社", "ＢＢＢ会社", "ＣＣＣ会社", "ＤＤＤ会社", "ＥＥＥ会社", ・・以下略") の部分を手修正でなければどんなコードでもいいのですが・・・