通过匹配标题传输数据
我有一个后端原始输出数据集，它由多个列组成，除了标题外，其中一些列是空的。
我想将这些数据转移到另一个工作表中，我们称之为后端处理。 在这个工作表中，我将准备一个标题行，它由原始数据集中包含的一些标题组成。 在已处理的工作表中不会有任何新的标题（所以基本上标题（已处理）是标题的一个子集（原始输出））。
有一次，我曾经用一个函数（Index＆Match）来解决这个问题，但是随着原始数据集的增长，从性能的angular度来看，这并不是最理想的。
从那以后，我一直在读VBA代码，这是我到现在为止所提出的：
Sub test() Dim r As Range, c As Range, msg As String With Sheets("Backend - raw").Range("4:4").CurrentRegion For Each r In Sheets("Backend - processed").Range("b7:t7") Set c = .Rows(1).Find(r.Value, , , xlWhole, , 0) If Not c Is Nothing Then .Columns(c.Column).Copy r.PasteSpecial xlPasteValues Else msg = msg & vbLf & r.Value End If Next Application.CutCopyMode = False End With End Sub 范围4：4是原始原始数据输出的标题find的地方。 范围b7：t7是find已处理数据表的标题的位置。
作为一个VBA的初学者，我很高兴它的工作，但仍然认为有一个巨大的改善余地：
1）它仍然很慢，大约需要10秒来完成40x500arrays。 2）我不知道如何让它停止寻找下一个标题，如果最后一个标题是空白的（范围b7：t7结束）3）我非常乐意接受新的/更好的方法来解决这个问题。
search，复制和粘贴可能是相当耗时的事情。 你可能会更好地阅读头一次到某种types的存储列表（一个Collection会适合你，因为它可以存储列号作为它的值和标题文本作为它的关键。
鉴于你只是复制和粘贴值（即你不需要传递单元格格式到你的处理表），然后读取数组到数组，然后将该数组写入表会更快。
下面的代码就是一个例子，但是我相信更多的人会认为它可以做得更快（例如，一旦它被使用，就丢弃集合中的头文件，或者不必为每个人find最后一个行号柱）。
Dim rawSht As Worksheet Dim procSht As Worksheet Dim headers As Collection Dim c As Integer Dim v As Variant Set rawSht = ThisWorkbook.Worksheets("Backend - raw") Set procSht = ThisWorkbook.Worksheets("Backend - processed") Set headers = New Collection For c = 1 To rawSht.Cells(4, Columns.Count).End(xlToLeft).Column headers.Add c, rawSht.Cells(4, c).Text Next For c = 2 To 20 rawCol = headers(procSht.Cells(7, c).Text) v = rawSht.Range(rawSht.Cells(5, rawCol), rawSht.Cells(Rows.Count, rawCol).End(xlUp)).Value2 procSht.Cells(8, c).Resize(UBound(v, 1)).Value = v Next
这是使用arrays（在0.03125秒40列×1000行）
Option Explicit Sub testArr() Const HDR1 As Long = 4 'header row on sheet 1 Const HDR2 As Long = 7 'header row on sheet 2 Dim ws1 As Worksheet, ur1 As Range, vr1 As Variant, c1 As Long, c2 As Long, r As Long Dim ws2 As Worksheet, ur2 As Range, vr2 As Variant, msg As String, t As Double t = Timer Set ws1 = Worksheets("Backend - raw") Set ws2 = Worksheets("Backend - processed") Set ur1 = ws1.UsedRange Set ur2 = ws2.UsedRange.Rows(ws2.UsedRange.Row - HDR2 + 1) Set ur2 = ur2.Resize(ur1.Row + ur1.Rows.Count - HDR1 + 1) vr1 = ur1 'copy from Range to array vr2 = ur2 For c1 = 1 To UBound(vr1, 2) For c2 = 1 To UBound(vr2, 2) If vr1(1, c1) = vr2(1, c2) Then For r = 2 To UBound(vr1, 1) vr2(r, c2) = vr1(r, c1) Next Exit For Else msg = msg & vbLf & vr1(HDR1, c1) End If Next Next ur2 = vr2 'copy from array back to Range Debug.Print "testArr duration: " & Timer - t & " sec" End Sub