excelの他のファイルへのリンク設定

質問

始めて質問させて頂きます。
EXcelの初歩的な計算式や、基本的な関数がわかる程度で、
マクロなどはわかりません。
よろしくお願いいたします。

環境はMACOS 10.5.5
excelのバーションは2008、または2004です。

1つのファイルに1000sheet以上あります。
1Sheetは横2列は固定ですが、縦は100行前後とバラバラです。

これを1つのファイルの1つのsheetにまとめたいのです。
（縦列と横列を逆にしてまとめたいのです）

そこでこういう方法を考えました。

まとめという新規のファイルを作成
加工前ファイル（1つのファイルに1000sheet以上）を開く

まとめのセルA1に、加工前のSheet1のセルA1を参照させる
まとめのセルB1に、加工前のSheet1のセルA2を参照させる
まとめのセルC1に、加工前のSheet1のセルA3を参照させる
（以下100まで繰り返し）
まとめのセルA2に、加工前のSheet1のセルB1を参照させる
まとめのセルB2に、加工前のSheet1のセルB2を参照させる
まとめのセルC3に、加工前のSheet1のセルB3を参照させる
（以下100まで繰り返し）

次に
まとめのセルA3に、加工前のSheet2のセルA1を参照させる
まとめのセルB3に、加工前のSheet2のセルA2を参照させる
まとめのセルC3に、加工前のSheet2のセルA3を参照させる
（以下100まで繰り返し）
まとめのセルA4に、加工前のSheet2のセルB1を参照させる
まとめのセルB5に、加工前のSheet2のセルB2を参照させる
まとめのセルC6に、加工前のSheet2のセルB3を参照させる
（以下100まで繰り返し）

ただし、この方法ですと、この参照の設定をすべて手作業で行わなければなりません。
例えば、sheet1 だけ設定したら、あとは、なんらかの方法で、sheet1000までの参照を簡単に行えないでしょうか？
よろしくお願いいたします。

回答No.7

lul · ベストアンサー

こんにちは、上手く行った様ですね、
なるべくシート数を少なくする為には以下の値を変更して下さい。
Const MaxLink As Long = 4000 '←ここの値を触って下さい。
65000位に設定しておけばよいと思うのですが、エラーが出るようでしたら60000→55000→50000といった感じに減らしてみて下さい♪

お礼

lulさん
本当にありがとうございます。
ご連絡が遅れ誠に申し訳ありませんでした。

何度も改良して頂きありがとうございました。
私、こういうフォーラム慣れておりませんで、
まさか、ここまでして頂けるとは思ってもおりませんでした。

年末に急な出張や仕事が入り、正確なご報告は年明けにさせて頂きます。
よろしくお願いいたします。

補足

lulさん
本当にありがとうございました。
また、ご連絡が遅れ誠に申し訳ありません。

lulさんのおかげで、いくつかの処理が非常にスムーズにいきそうです。
ありがとうございました。

今後もこのフォーラムに参加させて頂き、自分もいつかは、
他の方のお役にたてるようになればと思います。
本当にありがとうございました。

回答No.6

lul

こんにちは、たびたびすみませんがソースを貼り付けます。
Sub Macro2()
On Error GoTo ErrRTN1
Const MSheet As String = "まとめ" '←ここはまとめのシート名です
Const MaxLink As Long = 4000 '←ここの値を触って下さい。
Dim intRow As Integer, lngRow As Long
Dim SN As Integer
Dim sCnt As Long, i As Integer
Dim wb As Workbook
Dim ws As Worksheet, obj As Worksheet
Set wb = ActiveWorkbook
Dim colHyperLink As New Collection
Dim colsh As New Collection
Dim col As New Collection
Dim intMax As Long
On Error GoTo ErrRTN2
For Each obj In wb.Sheets
If InStr(1, obj.Name, MSheet) > 0 Then
obj.Delete 'False
Else
intMax = obj.Cells(65536, 1).End(xlUp).Row
If intMax > 255 Then intMax = 255
For intRow = 1 To intMax
col.Add Item:=obj.Name & "!" & obj.Cells(intRow, 1).Address
col.Add Item:=CStr(obj.Cells(intRow, 1).Value)
col.Add Item:=obj.Name & "!" & obj.Cells(intRow, 2).Address
col.Add Item:=CStr(obj.Cells(intRow, 2).Value)
colsh.Add col
Set col = Nothing
Next
colHyperLink.Add colsh
Set colsh = Nothing
End If
Next
Dim d, c, v
Dim intCol As Integer
lngRow = 1
Set ws = Worksheets.Add()
ws.Name = (MSheet & SN)
SN = SN + 1
For Each d In colHyperLink
intCol = 1
For Each c In d
If c(2) <> "" Then
ws.Hyperlinks.Add Anchor:=ws.Cells(lngRow, intCol), Address:="", SubAddress:=c(1) _
, TextToDisplay:=c(2)
sCnt = sCnt + 1
End If
If c(4) <> "" Then
ws.Hyperlinks.Add Anchor:=ws.Cells(lngRow + 1, intCol), Address:="", SubAddress:=c(3) _
, TextToDisplay:=c(4)
sCnt = sCnt + 1
End If
intCol = intCol + 1
Next
lngRow = lngRow + 2
If sCnt > MaxLink Then
Set ws = Worksheets.Add()
ws.Name = (MSheet & SN)
SN = SN + 1
sCnt = 0: lngRow = 1
End If
DoEvents
Next
MsgBox "終了しました"
Exit Sub
ErrRTN1:
MsgBox "シート名「" & MSheet & "」がありません、処理を終了します": Exit Sub
ErrRTN2:
MsgBox "エラーが発生しました、各シートの行数等に問題ないか確認して下さい": Exit Sub
End Sub

>120264510とか、336653925というように、数字が9桁のものでした。
>これを0120264510、03-3665-3925とすれば
この件に関しましては、すみません、コーディングミスです。
変数を定義していない為、勝手にDoubleで保持されてしまってました、ここは直しましたのでもう大丈夫かと思います。
もう一つの件ですが、MaxLinkという変数の値を40000件に変更しました、これでもう一度やってみてもらえませんか？
それでも落ちる場合はこの値を35000件に変更してみて下さい。
よろしくお願いします。

お礼

lulさん
本当にありがとうございます。

ご連絡が遅れ誠に申し訳ありませんでした。
日曜から急な出長が入り今戻ってまいりました。
本当に申し訳ありませんでした。

今お作り頂いたマクロを実行しました。
まさに、神の動きのようです。

明日、何パターンか実行して、再度ご報告させて頂きます。
本当にありがとうございました。
（まとめのsheetが6つできました。1つのsheetになるべく多くの行が表示され、まとめのsheetがなるべく少ないとありがたいのですが、、あつかましいお願い本当に申し訳ありません）

回答No.5

lul

こんにちは。
たびたび長いソースを記載してすみません。
これで問題なくできるかと思います。
Sub Macro2()
On Error GoTo ErrRTN1
Const MSheet As String = "まとめ" '←ここはまとめのシート名です
Dim intRow As Integer, lngRow As Long
Dim SN As Integer
Dim sCnt As Long, i As Integer
Dim wb As Workbook
Dim ws As Worksheet, obj As Worksheet
Set wb = ActiveWorkbook
Dim colHyperLink As New Collection
Dim colsh As New Collection
Dim col As New Collection
Dim intMax As Long
On Error GoTo ErrRTN2
For Each obj In wb.Sheets
If InStr(1, obj.Name, MSheet) > 0 Then
obj.Delete 'False
Else
intMax = obj.Cells(65536, 1).End(xlUp).Row
If intMax > 255 Then intMax = 255
For intRow = 1 To intMax
col.Add Item:=obj.Name & "!" & obj.Cells(intRow, 1).Address
col.Add Item:=obj.Cells(intRow, 1).Value
col.Add Item:=obj.Name & "!" & obj.Cells(intRow, 2).Address
col.Add Item:=obj.Cells(intRow, 2).Value
colsh.Add col
Set col = Nothing
Next
colHyperLink.Add colsh
Set colsh = Nothing
End If
Next
Dim d, c, v
Dim intCol As Integer
lngRow = 1
Set ws = Worksheets.Add()
ws.Name = (MSheet & SN)
SN = SN + 1
For Each d In colHyperLink
intCol = 1
For Each c In d
If c(2) <> "" Then
ws.Hyperlinks.Add Anchor:=ws.Cells(lngRow, intCol), Address:="", SubAddress:=c(1) _
, TextToDisplay:=c(2)
sCnt = sCnt + 1
End If
If c(4) <> "" Then
ws.Hyperlinks.Add Anchor:=ws.Cells(lngRow + 1, intCol), Address:="", SubAddress:=c(3) _
, TextToDisplay:=c(4)
sCnt = sCnt + 1
End If
intCol = intCol + 1
Next
lngRow = lngRow + 2
If sCnt > 60000 Then
Set ws = Worksheets.Add()
ws.Name = (MSheet & SN)
SN = SN + 1
sCnt = 0: lngRow = 1
End If
DoEvents
Next
MsgBox "終了しました"
Exit Sub
ErrRTN1:
MsgBox "シート名「" & MSheet & "」がありません、処理を終了します": Exit Sub
ErrRTN2:
MsgBox "エラーが発生しました、各シートの行数等に問題ないか確認して下さい": Exit Sub
End Sub

今回より、「まとめ」シートを予め削除して、新たに作成するというやり方にしています、６万件を超えたら別のシートを作成してそちらに記載するようにしています、一度試してみてください♪

お礼

lulさん
本当にありがとうございます。
さくさく表示され、空白のセルは空白で表示され、
感激の動きです。

ただ、途中で止まってしまいます。
止まる箇所や止まるデータがどうなってるか、
何通りか試してみてご報告させて頂きます。

「まとめ」シートを予め削除して、新たに作成するというやり方にしています、６万件を超えたら別のシートを作成してそちらに記載するようにしています。

これは、自動で「まとめ」シートが出来てくるということなのでしょうか？

宜しくお願いいたいします。

補足

lulさん
本当にありがとうございます。
ご報告させて頂きます。

途中で止まる箇所や止まるデータについてですが、
途中で止まる箇所は一定していません。

途中で止まるデータ（参照しているsheetのセル）には、
120264510とか、336653925というように、数字が9桁のものでした。
これを0120264510、03-3665-3925とすれば
止まらず次ぎに進みます。
また、試しに1とか100とかにしてみたところ、同じく止まります。
数字が1つ、または連続している場合に止まるようです。

それ以外に768行の35列目で止まります。
（数字が1つ、または連続している場合ではありません）
ここが限界なのでしょうか？

６万件を超えたら別のシートを作成してそちらに記載するの前に止まっているのでしょうか？

もし、お時間よろしければもう少しお願いできますでしょうか？
本当に申し訳ありません。

回答No.4

lul

こんにちは、以下のソースをご確認下さい。
これで表示に関しては解決するかと思われます。
Sub Macro1()
On Error GoTo ErrRTN1
Const MSheet As String = "まとめ" '←ここはまとめのシート名です
Dim intRow As Integer, lngRow As Long
Dim sCnt As Integer, i As Integer
Dim wb As Workbook
Dim ws As Worksheet, obj As Worksheet
Dim strAddress As String
Dim strVal As String
Set wb = ActiveWorkbook
Set ws = Sheets(MSheet)
lngRow = 1
On Error GoTo ErrRTN2
For Each obj In wb.Sheets
If obj.Name <> ws.Name Then
For i = 1 To 2
For intRow = 1 To 100
strVal = obj.Cells(intRow, i).Value
strAddress = obj.Name & "!" & obj.Cells(intRow, i).Address
ws.Hyperlinks.Add Anchor:=ws.Cells(lngRow, intRow), Address:="", SubAddress:=strAddress _
, TextToDisplay:=strVal
DoEvents
Next
lngRow = lngRow + 1
Next i
End If
Next
Exit Sub
ErrRTN1:
MsgBox "シート名「" & MSheet & "」がありません、処理を終了します": Exit Sub
ErrRTN2:
MsgBox "エラーが発生しました、各シートの行数等に問題ないか確認して下さい": Exit Sub
End Sub
で、途中でエラーになる件ですが、どうやら1つのシートに設定できるハイパーリンクの数が、合計で65530件までのようです。
それを超えるとエラーになります。
ですので65530件以上にする場合は複数のシートに分ける必要が出てきました…、その様な運用は可能ですか？

お礼

lulさん

本当にありがとうございます。
ただただ恐縮しております。
参照しているセルの内容は、まとめに表示できました。
（1行が表示されるのに1分位かかるようになってしまいました。）
（あと、空白にセルを参照した場合、まとめのセルの表示は、ブランクだと、大変ありがたいです。）
せっかくお教え頂いているのに申し訳ありません。

複数のシートに分けることは可能なのですが、
（あとで、値でベーストで合体できるので）
ただ、それだと、一番最初の質問のように、同じ作業を繰り返しになってしまうのではと思います。

貴重なお時間をさいて頂いているのに、ご無礼申し訳ありません。
もし、お時間ございましたら、宜しくお願いいたします。

回答No.3

lul

こんばんは、またまた遅くなりましてすみません。
内容を表示するだけでしたら以下の様に記述して下さい。
TextToDisplay:=obj.Cells(intRow, i)
これで問題なくできると思います。
もうひとつの件ですが、プログラム的に問題はなさそうなんですが、その対象セルにはどのような値が入っていますか？差し支えない範囲でおしえて下さい。
よろしくお願いします。

お礼

lulさん、本当にありがとうございます。
遅い時間まで申し訳ありません。

TextToDisplay:=obj.Cells(intRow, i)にして、マクロを実行したところ、
エラーが発生しました、各シートの行数等に問題ないか確認して下さい
とでて、何も表示されませんでした。

328行目で止まる件ですが、対象セルには、普通の文字の場合もあれば、空白のセルの場合もあります。

本当に申し訳ありません。宜しくお願いいたします。

回答No.2

lul

こんにちは、連絡が遅くなりまして申し訳ありませんでした。
ご質問の件ですが、セルに表示される文字は以下の箇所で作成しています。
TextToDisplay:=strAddress
これを変えてやれば良いのですが、具体的にどのような文字がご希望ですか？
例えばシート名＋連番にしたいのであれば
TextToDisplay:=obj.name & ":" & intRow
と言った感じに直せば良いかと思います。
他の表現を希望されるのでしたらどのようなものが良いか教えて下さい

お礼

lulさん、本当にありがとうございます。
恐縮しております。

まとめのセルA1に、加工前のSheet1のセルA1を参照させる
まとめのセルB1に、加工前のSheet1のセルA2を参照させる
まとめのセルC1に、加工前のSheet1のセルA3を参照させる

例えば、
加工前のSheet1のセルA1が東京なら、まとめのセルA1に東京と表示
加工前のSheet1のセルA2が大阪なら、まとめのセルB1に大阪と表示
加工前のSheet1のセルA3が京都なら、まとめのセルC1に京都と表示
参照先に入っているデータをまとめに表示したいのですが、、、

本当に申し訳ありません。
よろしくお願いいたします。

補足

lulさん、本当にありがとうございます。
いろいろ聞いて申し訳ありません。
もうひとつお願いいたします。

マクロを実行すると、
"エラーが発生しました、各シートの行数等に問題ないか確認して下さい"
必ず　328行目の66列目で止まってしまいます。
sheet64(2)!SBS66
（いくつかのファイルを試してみました）
（Sheet名もsheet64(2)のようになっているのと、1.2.3と連番になっているのも試しましたが同じ結果でした）
これはこちらのデータの問題でしょうか？

1.参照先に入っているデータをまとめに表示したい、
2.328行目の66列目も止まらない

この２つを何とか解決お願い出来ませんでしょうか？
本当に厚かましいお願いで申し訳ありませんが、宜しくお願いいたします。

回答No.1

lul

どうもVBA以外では思いつかないです。
なので試しにソース書いてみましたので良かったら使って下さい。
ツール→マクロ→VisualBasicEditorでエディタを開いて、
対象ブックを右クリックして、挿入→標準モジュールで追加したモジュールに以下のソースを貼り付けて下さい。
Sub Macro1()
On Error GoTo ErrRTN1
Const MSheet As String = "まとめ" '←ここはまとめのシート名です
Dim intRow As Integer, lngRow As Long
Dim sCnt As Integer, i As Integer
Dim wb As Workbook
Dim ws As Worksheet, obj As Worksheet
Dim strAddress As String
Set wb = ActiveWorkbook
Set ws = Sheets(MSheet)
lngRow = 1
On Error GoTo ErrRTN2
For Each obj In wb.Sheets
If obj.Name <> ws.Name Then
For i = 1 To 2
For intRow = 1 To 100
strAddress = obj.Name & "!" & obj.Cells(intRow, i).Address
ws.Hyperlinks.Add Anchor:=ws.Cells(lngRow, intRow), Address:="", SubAddress:=strAddress _
, TextToDisplay:=strAddress
Next
lngRow = lngRow + 1
Next i
End If
Next
Exit Sub
ErrRTN1:
MsgBox "シート名「" & MSheet & "」がありません、処理を終了します": Exit Sub
ErrRTN2:
MsgBox "エラーが発生しました、各シートの行数等に問題ないか確認して下さい": Exit Sub
End Sub
これで多分やりたい事は出来ると思います。
まとめる為のシート名は「まとめ」と言うシート名にしていますが、ロジック中のMSheetを書き換えれば他のシート名にも出来ます。

お礼

lulさん、有り難うございます。
せっかくVBAまで書いて頂いたのに、当方の力量不足で実行できません。
申し訳ありませんが、もう少し教えて下さい。
環境はMACOS 10.5.5
excelのバーションは2004です。

まとめという新規のファイルを作成し、まとめというSheetを作成し、処理するということでしょうか？
加工前ファイル（1つのファイルに1000sheet以上）に、まとめというSheetを作成し、処理するということでしょうか？

ツール→マクロ→VisualBasicEditorでエディタを開いて、
対象ブックを右クリックして、挿入→標準モジュールで追加したモジュールに以下のソースを貼り付けて下さい。

これは、マクロの基本だと思うのですが、、、ここのところ、もう少しお願いします。本当に申し訳ありませんが、宜しくお願いいたします。

補足

lulさん、有り難うございます。
加工前ファイル（1つのファイルに1000sheet以上）に、まとめというSheetを作成しマクロを実行するところまで出来ました。

ところが、
Sheet1!$A$1 Sheet1!$A$2 Sheet1!$A$3 Sheet1!$A$4
Sheet1!$B$1 Sheet1!$B$2 Sheet1!$B$3 Sheet1!$B$4
Sheet2!$A$1 Sheet2!$A$2 Sheet2!$A$3 Sheet2!$A$4
Sheet2!$B$1 Sheet2!$B$2 Sheet2!$B$3 Sheet2!$B$4
Sheet3!$A$1 Sheet3!$A$2 Sheet3!$A$3 Sheet3!$A$4
Sheet3!$B$1 Sheet3!$B$2 Sheet3!$B$3 Sheet3!$B$4
と表示されてしまいました。
ご迷惑おかけしますが、アドバイスを頂けると大変ありがたいのですが、、、宜しくお願いいたします。