1

我正在尝试使用主电子表格将多个工作表中的数据合并为一个。

但是，似乎我只能为连续列设置一个 sourceRange，并且我想复制不同的列（例如 A、C 和 K）。

有人可以帮助命令如何执行此操作吗？另外，我希望复制整列，只要它有数据（而不是指定单元格范围），有人知道如何做到这一点吗？

这是我正在使用的代码（在线找到）：

Sub MergeAllDeliverables()
    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim NRow As Long
    Dim Filename As String
    Dim WorkBk As Workbook
    Dim SourceRange As Range
    Dim DestRange As Range



' Create a new workbook and set a variable to the first sheet.
Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)


' Modify this folder path to point to the files you want to use.
FolderPath = "C:\Users\..."

' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 1

' Call Dir the first time, pointing it to all Excel files in the folder path.
Filename = Dir(FolderPath & "*.xl*")

' Loop until Dir returns an empty string.
Do While Filename <> ""
    ' Open a workbook in the folder
    Set WorkBk = Workbooks.Open(FolderPath & Filename)

    ' Set the cell in column A to be the file name.
    SummarySheet.Range("A" & NRow).Value = Filename


    ' Set the source range to be what you like.
    ' Modify this range for your workbooks.
    ' It can span multiple rows.
    Set SourceRange = WorkBk.Worksheets(1).Range("a:1")




    ' Set the destination range to start at column B and
    ' be the same size as the source range.
    Set DestRange = SummarySheet.Range("B" & NRow)
    Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
       SourceRange.Columns.Count)

    ' Copy over the values from the source to the destination.
    DestRange.Value = SourceRange.Value

    ' Increase NRow so that we know where to copy data next.
    NRow = NRow + DestRange.Rows.Count

    ' Close the source workbook without saving changes.
    WorkBk.Close savechanges:=False

    ' Use Dir to get the next file name.
    Filename = Dir()
Loop

' Call AutoFit on the destination sheet so that all
' data is readable.
   SummarySheet.Columns.AutoFit

End Sub
4

2 回答 2

1

使用.Range()您可以设置多个列 - 例如：

Dim rng As Range
Set rng = Sheets(1).Range("A1:A100, D3:D400")

而不是精确地指定这个：

Dim rng As Range
Dim lastRow As Long, lastColumn As Long

For i = 1 To Rows.Count - 1

    If IsEmpty(Cells(i, 1)) Then Exit For

Next i

Set rng = Range("A1:A" & i)

Cells(i, 1)中的1用于第一列A。

对于每一列，您可以创建一个 For 循环来计算填充单元格。

如果一列中的填充单元格之间有空单元格 - 你必须采取另一种方式（用户的答案......）:)

列A和D的示例：

For i = 1 To Rows.Count - 1

    If IsEmpty(Cells(i, 1).Value) Then Exit For

Next i

For j = 1 To Rows.Count - 1

    If IsEmpty(Cells(j, 4).Value) Then Exit For

Next j

Set rng = Range("A1:A" & i & ", D1:D" & j)
于 2016-05-29T10:33:58.967 回答
1

您可以设置“多列”范围，如下所示

Set multiColRng = Range("C:C, G:H, K")

但

  • 粘贴整个列的值可能很耗时（而且没用）

  • 列可以有“洞”，即它们的第一个和最后一个非空白单元格之间的空白单元格

因此仅粘贴“多列”范围的非空白值会很有用

这带来了对象Areas属性的问题，Range它既是解决方案（你必须通过它），也是目标的关注点（这有点棘手，至少对我来说是这样）

然后你可能想使用以下子：

Option Explicit

Sub PasteColumnsValues(multiColsRng As Range, destRng As Range)
    Dim col As Long, row As Long, colsArea As Long, rowsArea As Long

    With multiColsRng.Areas '<~~ consider "columns" areas in which columns range is divided
        For colsArea = 1 To .count '<~~ loop through those "column" areas
            With .Item(colsArea) '<~~ consider current "column" area
                For col = 1 To .Columns.count '<~~ loop through all "real" (single) columns of which a single "column" area consists of
                    row = 1 '<~~ initialize pasting row index
                    With .Columns.Item(col).SpecialCells(xlCellTypeConstants, xlNumbers) '<~~ consider current "real" (single) column
                        For rowsArea = 1 To .Areas.count '<~~ loop through all areas of which a single "real" column consists of
                            With .Areas(rowsArea) '<~~ consider current area of the current "real" (single) column
                                destRng(row, colsArea + col - 1).Resize(.count).Value = .Value '<~~ paste current area values
                                row = row + .Rows.count '<~~ update pasting row index
                            End With
                        Next rowsArea
                    End With
                Next col
            End With
        Next colsArea
    End With
End Sub

可以按如下方式使用：

Sub main()
    With ActiveSheet
        PasteColumnsValues Range("C:C, G:H"), .Range("N1") '<~~ the 1st argument MUST be a "multiple column" Range
    End With
End Sub
于 2016-05-29T19:39:08.197 回答