0

解決しようとしているExcel vbaの問題があり、インターネットと多くのフォーラムを精査した後、失敗しました。

質問 1: a2 のセルに Brian Johnson (または BrianJohnson) と表示されている場合、BrianJohnson.xlsx ファイルを開くことはできますか? このように開きたいファイルが約 30 個あるため、マスター ファイルは他のシートのセル参照を使用でき、問題が発生することはありません。

        Sub aaron_gather()
'
' aaron_gather Macro
Dim bestandopen
Application.ScreenUpdating = False
On Error Resume Next 'if there are no 12 sheets
 bestandopen = Dir("H:\Americorps\*")
    Do Until bestandopen = ""
      If bestandopen = "" Then Exit Do
       If Not bestandopen = "Americorps Master Sheet 1.xlsm" Then
        Workbooks.Open "H:\Americorps\" & bestandopen
    ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1) = ActiveWorkbook.Name
         For i = 1 To 12
          ThisWorkbook.Sheets("Total Hours").Cells(Rows.Count, 1).End(xlUp).Offset(, i) = ActiveWorkbook.Sheets(i).Range("E43")
         Next i
       ThisWorkbook.Sheets("Total Hours").Columns.AutoFit
    Workbooks(bestandopen).Close
 End If
      bestandopen = Dir
    Loop
End Sub
4

1 に答える 1

0

コンパイルされたがテストされていない...

Sub Test()

Const FLDR_PATH As String = "H:\Americorps\"
Dim c As Range, wbSource As Workbook
Dim shtTH As Worksheet, i As Integer
Dim cellTH As Range, filepath As String

    Set shtTH = ThisWorkbook.Sheets("Total Hours")

    For Each c In shtTH.Range("A2:A10") 'are names on total hours sheet?

        filepath = FLDR_PATH & Replace(c.Value, " ", "") & ".xlsx"

        If Len(Dir(filepath, vbNormal)) > 0 Then
            c.Font.ColorIndex = xlAutomatic
            Set wbSource = Workbooks.Open(filepath, , True) 'readonly

            For i = 1 To 12
                'copy values to same row as filename source
                c.Offset(0, i).Value = _
                    wbSource.Sheets(i).Range("E43").Value
            Next i

            wbSource.Close False
        Else
            c.Font.Color = vbRed 'file not found
        End If

    Next c

End Sub
于 2012-07-30T17:57:37.527 に答える