0

特定のフォルダー内のすべてのシートから Sheet1 から特定の範囲をインポートしようとしています。フォルダー内のすべての Excel ワークブックのすべてのワークシートをループして、すべてのセルのフォント、フォント サイズ、およびテキストの配置を変更することから始めましたが、VBA を初めて使用する場合は、次のことを達成するための助けが必要です。

具体的には。

  • ディレクトリ内の各ファイルにのみ、Sheet1 から Range("A3:J4") をインポートします。ただし、対応するために B 列から開始するようにフォーマットします。

  • 列 A を各範囲の元のファイル名に設定します。

    Range(A3:J4) は、最初のファイルの range(B1:K2) に移動し、次に range(B3:K4) のようになります。最初のファイルのファイル名を A1、次に 2 番目のファイル A3 にします。次に、リストは、フォルダー内のすべてのファイルに対してこのパターンを使用して構築を続けます

    Sub FormatFiles()
Const fPath As String = "D:\DataFolder\"
Dim sh As Worksheet
Dim sName As String

With Application
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .ScreenUpdating = False
End With

sName = Dir(fPath & "*.xls*")

Do Until sName = ""
    With GetObject(fPath & sName)
        For Each sh In .Worksheets
            With sh
                .Cells.HorizontalAlignment = xlLeft
                .Cells.Font.Name = "Tahoma"
                .Cells.Font.Size = 10
            End With
        Next sh
        .Close True
    End With
    sName = Dir
Loop

With Application
    .Calculation = xlAutomatic
    .EnableEvents = True
    .ScreenUpdating = True
End With
End Sub

助けてくれてありがとう。

4

1 に答える 1

0

このようなものが欲しかったですか？

Const fPath As String = "z:\docs\xlfiles\"
Dim sName As String
Dim intRow As Integer
Dim strCopyAddress As String
Dim wb As Workbook

strCopyAddress = "A3:J4"

Application.ScreenUpdating = False

sName = Dir(fPath & "*.xls*")
intRow = 1

Do Until sName = ""
    Set wb = Workbooks.Open(fPath & sName)
    ThisWorkbook.Sheets("Sheet1").Cells(intRow, 1) = sName
    wb.Sheets("Sheet1").Range(strCopyAddress).Copy _
       ThisWorkbook.Sheets("Sheet1").Cells(intRow, 2)
    wb.Close False

    intRow = intRow + 2
    sName = Dir
Loop

Application.ScreenUpdating = True
于 2013-01-26T23:24:22.520 に答える