Question

我正在尝试创建一个进入文件 1 并将数据复制到文件 2 的 VBA 脚本。文件 1 包含数据。

我遇到的问题是 file2 有更多的列，而且顺序不一定与 file1 中的列相同。同样，范围是错误的，我不确定如何选择所有相关数据。我如何确保它获取 file1 中每列的所有相关行？

Sub GetDatacClosedBook()

Dim src As Workbook
Set src = Workbooks.Open("C:\Users\Data\Documents\File1", True, True)
Set wbOpen = ActiveWorkbook

'this is the workbook in which the data will be transferred to
Workbooks.Open "C:\Users\Data\Documents\file2.xlsx"

Worksheets("Sheet1").Range("A1:D3").Formula = src.Worksheets("Sheet1").Range("A1:D3").Formula
wbOpen.Close

End Sub

Answer 1

您应该首先确定数据表中的列与目标表中的哪些列相匹配。然后一切都应该很容易。这可以通过多种方式完成。我假设你的 A 行有标题，那么你可以通过匹配标题来匹配列

Sub Macro()
    Dim destSht As Worksheet, srcSht As Worksheet
    Dim src_ColCnt As Integer, dest_ColCnt As Integer
    
    'Open the workbooks and grab the sheet reference, assign it to a worksheet variables
    Set srcSht = Workbooks.Open("D:\data.xlsx").Sheets("Sheet1")
    Set destSht = Workbooks.Open("D:\report.xlsx").Sheets("Sheet1")
    
    'Find how many columns in your destination sheet, how many columns in your source sheet and how many rows the source sheet data has.
    dest_ColCnt = destSht.Range("A1").End(xlToRight).Column
    src_ColCnt = srcSht.Range("A1").End(xlToRight).Column
    src_RCnt = srcSht.Range("A1").End(xlDown).Row - 1
    
    
    'The code below is basically loop over the source sheet headers, and for each header
    'find the column in your destination that has the same header
    'And then assign the data row by row once it knows which column in the data sheet go to which column in the destination sheet
    For i = 1 To src_ColCnt
        Header = srcSht.Cells(1, i)
        For j = 1 To dest_ColCnt
            If destSht.Cells(1, j).Value = Header Then
                For r = 1 To src_RCnt
                    'Do your assignment here row by row
                    'You can assign formula, value or different thing based on your requirement
                    'I assume your data start from the second row here
                    destSht.Cells(r + 1, j).Value = srcSht.Cells(r + 1, i).Value
                Next r
            End If
        Next j
    Next i
End Sub

这并不优雅，但应该给你一个想法。为了使上述更优雅，您可以使用一些东西。一、使用Scripting.Dictionary数据结构，以字典中的header作为key，以序号的列作为value。然后逐列循环您的目标工作表。从字典中检索正确的列序号。二、可以使用WorksheetFunctions.Match()来求序数。或者，如果您自己知道订单，那就更好了。您可以对订单数组进行硬编码，例如 mapOrder = Array(3,1,5,6) 并仅使用此数组来匹配列。

Answer 2

您可以编写一个指向特定工作簿的函数，定位列（可能通过标题）并将该列数据捕获到函数返回的数组中。然后将数组按所需顺序写入另一张纸。

子程序和函数示例：

Private Sub GetDatacClosedBook()

Dim ExampleArray As Variant
Dim Destination As Range

    ExampleArray = LocateColumnReturnArray(ThisWorkbook.Sheets("Sheet1"), "Value to find in row1 of the desired column")
    
    
    Set Destination = ThisWorkbook.Sheets("Sheet2").Range("A1")
    Destination.Resize(UBound(ExampleArray), 1) = ExampleArray

End Sub

Public Function LocateColumnReturnArray(ByRef TargetWorksheet As Worksheet, ByVal TargetColumnHeader As String) As Variant

Dim LastUsedColumn As Long
Dim TargetCell As Range

    With TargetWorksheet
        LastUsedColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
        
        For Each TargetCell In .Range(.Cells(1, 1), .Cells(1, LastUsedColumn))
            If TargetCell.Value = TargetColumnHeader Then
                LastUsedRow = .Cells(.Rows.Count, LastUsedColumn).End(xlUp).Row
                LocateColumnReturnArray = .Range(.Cells(2, TargetCell.Column), .Cells(LastUsedRow, TargetCell.Column))
                Exit Function
            End If
        Next TargetCell
    End With
End Function

您可以采用此概念并将其应用于您的要求。对于您想要数据的每一列，此函数可以根据需要运行多次。您还需要为每列数据指定目标，但您可以修改上述内容以使用基于您的数据正在写入的列的循环。

VBA - 将数据从一个文件拉到另一个文件

2 个答案: