将特定列（将近 250 个）从一个 Excel 工作簿迁移到另一个

Question

正在将数据从一个工作簿迁移到另一个。在新工作簿中，我只需要特定的列（几乎是 250 个）。由于主文件中的数据不一致且不在同一范围内，那么我如何提取这250列？因为，我是 VBA 的新手，我尝试了下面的代码，它可以工作，但我必须为所有 250 列编写长代码？任何帮助将不胜感激。

Sub Data_Migration()

Dim y As Workbook
Dim x As Workbook
Dim ws As Worksheet
Dim sh As Worksheet
Dim rng As Range
Set y = ThisWorkbook
Application.ScreenUpdating = 0



Set x = Workbooks.Open("file path")
 'Column Q from master file with worksheet name cba is copied in new workbook with sheet name abc and pasted in column D
Set ws = y.Sheets("abc")
Set sh = x.Sheets("cba")
Set rng = sh.Range("Q2:Q11443") 
rng.Copy
y.Sheets("abc").Range("D1").PasteSpecial xlValues
Application.CutCopyMode = False


Set ws = y.Sheets("abc")
Set sh = x.Sheets("cba")
Set rng = sh.Range("Z2:Z11443") 
rng.Copy
y.Sheets("abc").Range("E1").PasteSpecial xlValues
Application.CutCopyMode = False


Set ws = y.Sheets("abc")
Set sh = x.Sheets("cba")
Set rng = sh.Range("AI2:AI11443") 
rng.Copy
y.Sheets("abc").Range("F1").PasteSpecial xlValues
Application.CutCopyMode = False

x.Close
End sub

Answer 1

您需要一个 For .. Next 循环。基本上，

Dim C As Long
For C = 1 to 250
    ' enter repetitive code here
Next C

如果 C 是您的列号，您可以使用 C 作为列号而不是 "A"、"B"、"C"。 Excel 不太擅长字母。它将您键入的 A 转换为 1，B 转换为 2，C 转换为 3 等等 - 最多 250。

但是，您似乎不需要连续的列。因此，您创建了一个包含所需数字的数组。

Dim Arr As Variant
Arr = Array(1, 12, 16, 25, 32)  ' list all your 250 columns.

现在，Arr(0) = 1，Arr(1) = 12，Arr(2) = 16 等等。然后你构造你的循环来引用这些数字。

Dim n As Integer
For n = 0 to Ubound(Arr)    ' that the number of elements in Arr
    C = Arr(n)
    Debug.Print C      ' this will write C in the immediate window
Next n

在此结构中，您可以使用 C 作为列号，例如，

Set Rng = Sh.Range(Cells(3, C), Cells(11443, C))

Cells(3, C) 指定A3，如果C = 1

PS 我刚想到你可能也需要这个：- Range("ZH2").Column 应该 return 列的列号 "ZH"

Answer 2

将以下代码粘贴到标准代码模块中（默认情况下'Module1'，但您可以根据自己的喜好命名）。

Sub Main()
    ' 21 Mar 2017

    Dim WsS As Worksheet                        ' S = Source
    Dim WbT As Workbook, WsT As Worksheet       ' T = Target
    Dim Cs As Long, Ct As Long                  ' Column numbers: Source & Target
    Dim Clms As Variant
    Dim i As Integer                            ' index for Clms

    Application.ScreenUpdating = False
    On Error GoTo ErrExit
    ' Source is the first worksheet in the active workbook:
    Set WsS = ActiveWorkbook.Worksheets("Haseev")
    Set WbT = Workbooks.Add(xlWBATWorksheet)
    Set WsT = WbT.Worksheets(1)
    WsT.Name = "Extract 250"                    'name the target sheet

    Clms = Array(1, 4, 8, 13)                   ' list column numbers < 17
    For i = 0 To UBound(Clms)
        CopyColumn WsS, WsT, Clms(i), Ct
    Next i

    For Cs = 17 To Columns("CHU").Column Step 9
        CopyColumn WsS, WsT, Cs, Ct
''''        If Ct > 10 Then Exit For
    Next Cs
ErrExit:
    Application.ScreenUpdating = True
End Sub

理解代码：- 将当前活动的工作簿设为 "Source"，这意味着您必须查看要从中复制数据的工作簿。该代码期望在此工作簿中找到名为 "Haseev" 的作品 sheet。更改代码中的名称或将整行代码更改为

Set WsS = ActiveWorkbook.Worksheets(1)

这指定了工作簿中的第一个工作sheet，这很有意义，因为像您这样的大型工作簿不太可能有太多 sheet。

该代码将创建一个新工作簿，其中包含一个 sheet。它将命名为 sheet "Extract 250"。将代码中的名称更改为您喜欢的名称。接下来，代码会将选定的列复制到新工作簿。

Clms = Array(1, 4, 8, 13)

您可以指定要复制的列 - 数量不限，数字以逗号分隔。如果你不想要任何，只需将规范留空，如 Clms = Array()

在下一个循环中，每第 9 列被复制一次，从第 17 列开始到第 "CHU" 列。你可以修改"CHU"。行

''''        If Ct > 10 Then Exit For

是我测试的遗留物。您可能想将它用于相同的目的。删除禁用代码的撇号，在将 10 列复制到新工作簿后，循环将停止复制。

您可能会注意到上面的代码不包含任何复制或粘贴。相反，它会调用下一个子程序，您应该将其粘贴到上面已复制的主程序下方。

Private Sub CopyColumn(WsS As Worksheet, _
                       WsT As Worksheet, _
                       ByVal Cs As Long, _
                       Ct As Long)
    ' 21 Mar 2017
    ' Ct is a return Long

    If Cs > 0 Then              ' column number must be > 0
        Ct = Ct + 1
        WsS.Columns(Cs).Copy Destination:=WsT.Columns(Ct)
    End If

End Sub

基本上，Main 过程只管理该子程序将被调用的 250 多次。

输出工作簿将具有 Excel 给出的通用名称，如 "Sheet1"。您可以将其保存为您想要的任何名称，也可以将其关闭并在下次要查看时创建一个新名称。

将特定列（将近 250 个）从一个 Excel 工作簿迁移到另一个

Migrating specific columns (almost 250) from one Excel workbook to another

excel

vba

excel-2013