エクセルマクロです。

質問

エクセルマクロを使い，100個ほどのファイルの合成プログラム(ファイルを読み込み，中のデータを一つのファイルに貼り付ける)を作っています。シート名が固定されていれば読み込むことが出来るのですが，シート名とファイル名が同じためインデックスエラーが出てしまいます。どのような対処法があるでしょうか…出来ればサンプルコードを教えていただけるとうれしいのですが…よろしくお願いします

回答No.6

Wendy02 · ベストアンサー

こんばんは。

its (Internet Document Set) のファイルは、一体、どんなファイル形式かは分かりませんが、Excelで取れるものなら、基本的には、CSV ファイルなどと変わらないはずです。

直すのでしたら、このようにしたらどうでしょうか？

＞For i = 1 To MaxG
＞If Workbooks(FF).Worksheets(FF).Cells(i, 1).Value = "" Then
＞Exit For
＞Else
＞Workbooks("Main.xls").Worksheets(FF).Cells(i, DLine).Value = ＞Workbooks(FF).Worksheets(FF).Cells(i, 1).Value
＞End If
＞Next i

↓
For i = 1 To MaxG
If Workbooks(FF).ActiveSheet.Cells(i, 1).Value = "" Then
Exit For
Else
'Main.xls 側のデータ書き込みシートを仮にSheet2 とする
Workbooks("Main.xls").Worksheets("Sheet2").Cells(i, DLine).Value = Workbooks(FF).ActiveSheet.Cells(i, 1).Value
End If
Next i

＞DName = Mid(FF,1, InStr(FF,".")-1)こちらを使わさせていただいたのですがやはり上手くいきません。。。

元のファイルにシート自体が存在しない場合、ActiveSheet でよいです。

お礼

ありがとうございます。書き込みシートをsheet2にする時に単純に""をつけるのを忘れていました。
3日間悩んで皆様にいろいろ考えていただいたのに…なんとも間抜けな結果でした。かなり恥ずかしいです。
でも本当に丁寧に説明していただいてありがとうございました。

回答No.5

Wendy02

追伸です。CSVファイルでしたら、

＞ここは今まで「sheet1」となっていました。今回は「sheet1」ではなくsheet名とファイル名が同じとなります。

ActiveSheetでもよいのではないでしょうか？わざわざシート名を入れる必要もありません。

回答No.4

Wendy02

こんにちは。

＞今回は「sheet1」ではなくsheet名とファイル名が同じとなります。

それでエラーが出るということですか？もしかしたら、CSVファイルではありませんか？

For i = 1 To MaxG
If Workbooks(FF).Worksheets(FF).Cells(i, 1).Value = "" Then
Exit For
Else
Workbooks("Main.xls").Worksheets(FF).Cells(i, DLine).Value = Workbooks(FF).Worksheets(FF).Cells(i, 1).Value
End If
Next i

でしたら、そのようにすれば、通るのではありませんか？
それとも、拡張子があるので、それを取って、

DName = Mid(FF,1, InStr(FF,".")-1)

とでもしたらどうですか？

補足

ファイルはCSVではなくitsと言う拡張子になっています。
DName = Mid(FF,1, InStr(FF,".")-1)こちらを使わさせていただいたのですがやはり上手くいきません。。。

回答No.3

Wendy02

こんばんは。

まず、Excelの Version はいくつなのかな？
コードをみると、「Excel 97」みたいに見えます。

苦労されて作られているのはわかるのですが、もう少し、単純に考えたほうがよさそうです。ずいぶん無駄な部分が多いような気がします。同じものを変数を差し替えたり、変数を使わなくてもよい部分に変数を置くとか、ひじょうにややこしくなります。それから、With の省略形を使ったほうが、速くなるし、見栄えも良くなります。

それはともかく、問題の部分から話に入って、各詳細な部分は後回しのほうがよさように思います。

インデックス・エラーは、ここの部分なんでしょうけれども、
If Workbooks(FF).Worksheets(DName).Cells(i, 1).Value = "" Then

'各値初期設定

DName = : 'シート名
↑
この部分、「:」というシート名はありえないですから。Sheet名は、なんでしょうか？これが、直接のエラーの原因でしょう。

それと、いくらFileSearch でも、FileType プロパティを付けずに、以下のようにするのはやめたほうがよいのでは？たぶん、そのフォルダには、それしかないのは分かるのですが。

×　SName = "*.*"
○　SName = "*.xls"

補足

DName = : 'シート名
↑
この部分、「:」というシート名はありえないですから。Sheet名は、なんでしょうか？

ここは今まで「sheet1」となっていました。今回は「sheet1」ではなくsheet名とファイル名が同じとなります。

回答No.2

maruru01

こんにちは。maruru01です。

>シート名とファイル名が同じため
だったら、ファイル名を使用してシートを指定すればいいのでは？

Worksheets(ファイル名)

あとは、ファイル名をどうやって指定しているかになります。
フルパスなら、パス部分（とおそらく拡張子部分）を除いてやればいいと思います。

何にせよ、もう少し詳細な情報がないと具体的な回答は難しいでしょう。
現状のコードをアップしてみてはいかがですか？

補足

現状のコードは
Sub FileSearch(): 'ファイル検索

Dim sfolda As String
Dim SName As String
Dim i, j, k, n As Integer
Dim ww As String
Dim L, S As Integer
Dim ws As Object

Dim DName As String
Dim PP, FF As String
Dim MaxG, DKoumoku, DLine As Integer
Dim MaxFileSu As Integer

'各値初期設定
MaxFileSu = 100: '最大ファイル数
DName = : 'シート名
MaxG = 1000: '最大検索行数
DLine = 1: 'データ入力行数カウント

Application.ScreenUpdating = False

'現在のフォルダのパスを設定
sfolda = ThisWorkbook.Path

'ファイル名を入れるシートをセットおよび初期化
Set ws = Workbooks("Main.xls").Worksheets("search")
ws.Range("B1").ClearContents
ws.Range("A4:B200").ClearContents
ws.Cells(1, 2).Value = sfolda

'各ファイル名を検索しsearchシートに登録
SName = "*.*"
n = 1

With Application.FileSearch
.LookIn = sfolda
.Filename = SName
rs1 = .Execute
If rs1 = 0 Then Exit Sub
For Each nm In .FoundFiles
ww = nm
S = 1
While S > 0
S = InStr(1, ww, "\", 1)
L = Len(ww)
ww = Right(ww, L - S)
Wend
If ww <> "Main.xls" Then
ws.Cells(n + 3, 1).Value = n: '１列目に番号セット
ws.Cells(n + 3, 2).Value = ww: '２列目にファイル名セット
n = n + 1
End If
Next nm
End With

'======================================================================
'合成処理

For n = 1 To MaxFileSu

'ファイル名をセット
PP = ws.Cells(1, 2).Value
If ws.Cells(n + 3, 2).Value = "" Then Exit For
FF = ws.Cells(n + 3, 2).Value
PP = PP & "\" & FF

'ファイルオープン
Workbooks.Open (PP)

'各シートからデータをMainに追加貼り付け
For i = 1 To MaxG
If Workbooks(FF).Worksheets(DName).Cells(i, 1).Value = "" Then
Exit For
Else
Workbooks("Main.xls").Worksheets(DName).Cells(i, DLine).Value = Workbooks(FF).Worksheets(DName).Cells(i, 1).Value
End If
Next i
DLine = DLine + 1
'ファイルクローズ
Workbooks(FF).Close
Next n

End Sub
コードはこのようなものなのですが…がんばっていたら訳が分からなくなってしまいまして…お願いします

回答No.1

WWolf

質問内容というか仕様が抽象的な部分があり分りにくいのですが、
シート位置が同じであればWorksheets(1)などで指定しては？

補足

説明が分かりにくく申し訳ありません。エクセルのsheet1(sheet1=ファイル名)に縦に800個ほどのデータが並んでおります。それらのデータファイルが40個ほど一つのフォルダに保存されています。それらのデータを一つのエクセルのシートにまとめたいのですがどうしたらよいでしょうか？例えばA列にはブック1のデータB列にはブック2のデータというようにしたいのですが…