从Excel工作表中提取列范围-Java 学习之路

我目前正致力于将多个工作簿中的多个工作表中的数据解析为摘要工作表 . 我已经能够从所有工作表和工作簿中选择某些单元格，但是如果可能的话，我想提取一系列列 . 如何将此选项添加到循环条件中？例如，如果我有一个名为“星期一”的工作表，我想提取单元格范围A2到C57并将其添加到我新创建的工作表 .

Option Explicit
Sub GetMyData()
Dim myDir As String, fn As String, SheetName As String, SheetName2 As String, SheetName3 As String, n As Long, NR As Long
'***** Change Folder Path *****
myDir = "C:\attach"

'***** Change Sheetname(s) *****
SheetName = "Title"
SheetName2 = "Total"
SheetName3 = "Monday"

'***Loops through specified directory and parces data from each worksheet within each workbook by selecting specified .
fn = Dir(myDir & "\*.xlsx")
Do While fn <> ""
    If fn <> ThisWorkbook.Name Then
        With ThisWorkbook.Sheets("ImportTable")
            NR = .Cells(Rows.Count, 1).End(xlUp).Row + 1

            'Pick cells from worksheet "Title"
            With .Range("A" & NR)
                .Formula = "='" & myDir & "\[" & fn & "]" & SheetName & "'!A1"
                .Value = .Value
            End With
            With .Range("B" & NR)
                .Formula = "='" & myDir & "\[" & fn & "]" & SheetName & "'!A2"
                .Value = .Value
            End With
            With .Range("C" & NR)
                .Formula = "='" & myDir & "\[" & fn & "]" & SheetName & "'!B4"
                .Value = .Value
            End With
            With .Range("D" & NR)
                .Formula = "='" & myDir & "\[" & fn & "]" & SheetName & "'!B5"
                .Value = .Value
            End With
            With .Range("E" & NR)
                .Formula = "='" & myDir & "\[" & fn & "]" & SheetName & "'!B6"
                .Value = .Value
            End With
            With .Range("F" & NR)
                .Formula = "='" & myDir & "\[" & fn & "]" & SheetName & "'!B7"
                .Value = .Value
            End With
            With .Range("G" & NR)
                .Formula = "='" & myDir & "\[" & fn & "]" & SheetName2 & "'!B26"
                .Value = .Value
            End With
            With .Range("H" & NR)
                .Formula = "='" & myDir & "\[" & fn & "]" & SheetName2 & "'!A1"
                .Value = .Value
            End With
        End With
    End If
    fn = Dir
 Loop
 ThisWorkbook.Sheets("ImportTable").Columns.AutoFit
 End Sub

1 回答

如果将链接创建移动到单独的子代码，则代码将更加简洁，并且您可以让子代码自动调整公式的类型（单个单元格的常规或单元格块的数组公式）

Sub tester()

    Dim rng As Range

    Set rng = ActiveSheet.Range("A2")

    LinkToFile "C:\_Stuff\test", "temp report.xlsx", "Sheet1", "A1:D20", rng

    Set rng = ActiveSheet.Range("F2")

    LinkToFile "C:\_Stuff\test", "temp report.xlsx", "Sheet1", "A1", rng

End Sub




Sub LinkToFile(fPath As String, fName As String, shtName As String, _
               addr As String, rngInsert As Range)

    Dim rngTmp As Range, f As String

    If Right(fPath, 1) <> "\" Then fPath = fPath & "\" 'win only!

    f = "='" & fPath & "[" & fName & "]" & shtName & "'!" & addr

    'linking to a range, or a single cell ?
    If InStr(addr, ":") > 0 Then
        Set rngTmp = rngInsert.Parent.Range(addr) 'to get num rows/cols
        rngInsert.Resize(rngTmp.Rows.Count, rngTmp.Columns.Count).FormulaArray = f
    Else
        rngInsert.Formula = f
    End If

End Sub

回复于 2024-05-06T15:30:25+08:00

从Excel工作表中提取列范围

1 回答

相关问题