[求助] 按表头复制指定列

准提部林

基本法, find + copy
Sub TEST()
Dim xU As Range, xR As Range, xF As Range
Set xU = Sheet1.UsedRange
For Each xR In xU.Rows(1).Cells
    Set xF = Sheet2.[1:1].Find(xR.Value, Lookat:=xlWhole)
    If xR = "" Or xF Is Nothing Then GoTo 101
    xR(2).Resize(xU.Rows.Count - 1).Copy xF(2)
101: Next
End Sub

yyyjianchao

准提部林 发表于 2020-8-28 10:26
先用字典記錄標題列位置+array處理
或用find, match都可以找到相對應列再直接粘貼, 速度較慢罷!!

典記錄標題列位置+array 如何表达

准提部林

yyyjianchao 发表于 2020-9-9 20:10
典記錄標題列位置+array 如何表达

"目标"工作表第一行"标题8"重覆兩次, 何意???

准提部林

yyyjianchao 发表于 2020-9-9 20:10
典記錄標題列位置+array 如何表达

不管了, 先給個樣板:
Sub TEST()
Dim Arr, Brr, xD, R&, C&, U&
Sheet2.UsedRange.Offset(1, 0).EntireRow.Delete
Set xD = CreateObject("Scripting.Dictionary")
Brr = Range(Sheet2.[a1], Sheet2.Cells(1, Columns.Count).End(xlToLeft))
For C = 1 To UBound(Brr, 2): xD(Brr(1, C) & "") = C: Next 'sheet2將對應"列號"入字典
Arr = Sheet1.UsedRange
ReDim Brr(1 To UBound(Arr) - 1, 1 To UBound(Brr, 2))
For C = 1 To UBound(Arr, 2)
    U = xD(Arr(1, C) & "") '取得sheet1與sheet2對應列號
    If U = 0 Or Arr(1, C) = "" Then GoTo c01
    For R = 2 To UBound(Arr): Brr(R - 1, U) = Arr(R, C): Next R
c01: Next C
With Sheet2.[A2].Resize(UBound(Brr), UBound(Brr, 2))
     .NumberFormatLocal = "@"
     .Value = Brr
End With
End Sub


  

yyyjianchao

准提部林 发表于 2020-9-10 11:55
"目标"工作表第一行"标题8"重覆兩次, 何意???

那个是不该重复的，