Question

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

但是，我似乎只能为连续的列设置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

Answer 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)

细胞（i，1）中的 1 用于第一列 A 。

对于每一列，您都可以创建一个For-Loop来计算已填充的单元格。

如果列中填充的单元格之间有空单元格 - 您可以采用其他方式（用户的答案......）：）

列 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)

Answer 2

你可以设置一个＆＃34;多列＆＃34;范围如下

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

但是

粘贴整列的值可能非常耗时（并且无用）
列可以有＃34;孔＆＃34;，即第一个和最后一个非空白单元格之间的空白单元格

因此仅粘贴＆＃34;多列的非空白值＆＃34>非常有用。范围

这带来了Range对象Areas属性的问题，这个问题都是解决方案（你有通过它）和关注点（＆＃39）一个小的棘手的，至少它是对我来说的目标

然后您可能想要使用以下子：

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

如何在xls中为多个列设置SourceRange？

2 个答案: