許せない心理テスト

ExecuteExcel4Macroを使って他のブックを開かずにセルを参照しているのですが、worksheet(1)という記述を使いたいのですがどうすればよいでしょうか?
Target1 = "'" & Path & "[" & buf & "]sheet1'!R75C3"
上記だとsheet1という名前でなかったらエラーが出てしまうので・・・。

A 回答 (4件)

>ファイル数は3000ほどあるので、開いていたら処理が間に合わないような・・・。



テンプレートでファイルを作っているならともかく、シート名の定まらないようなブックを、3000個も作ってしまった後に、値を取りたいというのは、もう計画の時点で、失敗を示しているように思います。単に、以下は、実験的なものを越えることはありません。

-------------------------------------------
>worksheet(1)という記述を使いたいのですがどうすればよいでしょうか?
Worksheets(1)のことだと思いますが、シートタブの左端という意味です。

以下は、Excel 2003 までのファイル構造のみ
コードの使い方など、細かい解説はしません。

現在は、安全のために、100ファイル以上では働かないようにしてあります。
If i > 100 Then Exit Sub '安全のために、100ファイルを超えたら、マクロ中止
全部実行するには、
''If i > 100 Then Exit Sub '安全のために、100ファイルを超えたら、マクロ中止
コメントブロック(')を加える。

'標準モジュール。以下のADOオブジェクトは、できる限り事前バインディングのほうが有利です。エラーが残っているかもしれません。
'=========================================
Sub Main()
  Dim myPath As String
  Dim fn As String
  Dim i As Long
  Dim buf As Variant
  Dim ret1 As Variant
  i = 1
  myPath = ThisWorkbook.Path & "\"
  fn = Dir(myPath & "*.xls", vbNormal)
  Do While fn <> ""
    If fn Like "*.xls" Or StrComp(ThisWorkbook.Name, fn, 1) <> 0 Then
      buf = getSheetsName(fn)
    End If
    If IsArray(buf) Then
      '*注意
      ret1 = ExecuteExcel4Macro("'" & myPath & "[" & fn & "]" & buf(0) & "'!R75C3")
      If VarType(ret1) <> vbError Then
        If ret1 <> "" Then
          Cells(i, 1).Value = ret1
          i = i + 1
        End If
      End If
    End If
    If i > 100 Then Exit Sub '安全のために、100ファイルを超えたら、マクロ中止
    fn = Dir
  Loop
End Sub

Function getSheetsName(FileName As String)
'ファイル名からシート名を取る関数
  Dim oConn As Object 'New ADODB.Connection
  Dim oRS As Object ' New ADODB.Recordset
  Dim shName As String
  Dim buf As String
  Dim shLists() As String
  Dim i As Long
  Dim j As Long
  On Error GoTo ErrHandler
  Const adSchemaTables As Integer = 20
  Set oConn = CreateObject("ADODB.Connection")
  With oConn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .Properties("Extended Properties").Value = "Excel 8.0"
    .Open FileName
  End With
  Set oRS = oConn.OpenSchema(adSchemaTables)
  Do Until oRS.EOF
    shName = oRS.Fields("TABLE_NAME").Value
    If Right(shName, 1) = "$" Or Right(shName, 1) = "'" Then
      ReDim Preserve shLists(i)
      buf = Mid$(shName, 1, Len(shName) - 1)
      buf = Replace(buf, "$", "", 1)
      buf = Replace(buf, "'", "")
      shLists(i) = buf
      i = i + 1
    End If
    oRS.MoveNext
  Loop
  oRS.Close
  oConn.Close
ErrHandler:
  Set oRS = Nothing
  Set oConn = Nothing
  '確認用
   If i > 0 Then
   getSheetsName = shLists() '出力は、配列
  End If
End Function
'-------------------------------------------
''掲示板で、あれこれ質問するよりも、自分の分かる範囲で、ファイルOpen, Close でコードを作ったほうが延べ時間では早いです。しかし、実際のマクロは遅いです。以下で実験してみました。しょせん、一回キリのようなマクロは、テクニックは必要ありません。

ただし、VBAマクロは、Run してみなければ分からないものが多いです。

'-------------------------------------------
Sub Main2()
  Dim myPath As String
  Dim fn As String
  Dim i As Long
  Dim buf As Variant
  i = 1
  myPath = ThisWorkbook.Path & "\"
  fn = Dir(myPath & "*.xls", vbNormal)
  Do While fn <> ""
    If fn Like "*.xls" Or StrComp(ThisWorkbook.Name, fn, 1) <> 0 Then
      ''*シートの設定
      buf = getSheetsNameVal(fn, 1, "C75")
    Cells(i, 1).Value = buf
    i = i + 1
    End If
    If i > 100 Then Exit Sub '実験用のため100ファイルに限定させる
    fn = Dir
  Loop
End Sub
Function getSheetsNameVal(FileName As String, iSh As Integer, nRng As String)
  Dim objBook As Workbook
  Dim sh As Worksheet
  Dim ret As Variant
  On Error GoTo ErrHandler
  '開く時にブックを制御(Screen,Alert,自動計算,Event)
  With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    .Calculation = xlManual
    .EnableEvents = False
    Set objBook = Workbooks.Open(FileName, ReadOnly:=False)
    With objBook
      ret = .Worksheets(iSh).Range(nRng).Value
    End With
    objBook.Close False
  End With
ErrHandler:
  With Application
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
    .ScreenUpdating = True
  End With
  Set objBook = Nothing
  If VarType(ret) <> vbError Then
    getSheetsNameVal = ret
  End If
End Function
'-------------------------------------------

p.s.バイナリでシート名を取る方法は知らないわけではないけれども、私は、そのようなコードを書く気力がありません。VBAマクロは、Runを繰返してみないと分からないものがあります。

この回答への補足

そうですね。はじめの段階からおかしいです。
あまり知らないお客さんがご自分で作られたファイルですから、いろんなのがあって当然かと…。
1回きりの処理なのでちまちまやります。

補足日時:2010/04/07 12:09
    • good
    • 0

>てことは、普通に開いて、閉じての繰り返しですか?



えっと,本当にごめんなさい? どこが判らなくて/何が出来なくての,その追加ご質問でしょうか。

「ブックを開いて1枚目シートの所定の番地のセルから値を取得する」(取得して何をしたいのかは,当初ご質問より全く問われていません)と最初から繰り返しご説明している事なので,改めて補足してお話しすべき内容を追加ご質問から拾いあげる事が出来ません。
    • good
    • 0

ブックを3000冊開くのが遅いと思いこんでいる?実証されている?のが問題だとすれば,出来るだけ早くブックを開くマクロを組んだ方が無い方法を模索するより早く結果を出せます。


・screenupdatingを抑制して,若しくはgetobjectで開く
・再計算は手動(xlcalculationmanual)にしておいて開く



ブックを開かないで今のアプローチを堅持したいのでしたら,次の資料
http://officetanaka.net/excel/vba/tips/tips28.htm
と,そこからリンクされているその次の資料
http://officetanaka.net/excel/vba/tips/tips29.htm
が参考になります。

この回答への補足

すばやいご回答ありがとうございます。
よく考えれば別に開いても問題ないレベルのスピードだと思います。
ってことは、普通に開いて、閉じての繰り返しですか?

補足日時:2010/04/06 23:21
    • good
    • 0

ExecuteExcel4Macroを使いたければ,そこには実際の正しいシート名を記入しなければなりません。

回避する方法はありません。

素直にマクロで(見えないように・邪魔にならないように)ブックを開き,worksheets(1)の所定のセルを取得するのが最も簡易な手です。それで何か困ることがある(或いはマクロが書けない)ようなら,困り所を具体的に挙げて別途ご相談を投稿してみてください。

この回答への補足

特にExecuteExcel4Macroを使う必要はないのです。
(ファイルを開かずにセルを参照したいのです。その他でできるならそれで良いんですが)
あるフォルダにあるファイルを順次読みながらセルを参照してそのシートのセルの必要な
部分だけをとって、一覧表を作りたいのです。
ファイル数は3000ほどあるので、開いていたら処理が間に合わないような・・・。
分かれば、教えてください。

補足日時:2010/04/06 21:51
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


おすすめ情報