|
- Sub Macro1()
- Dim arr, brr, d, sht As Worksheet, j%
- Set d = CreateObject("scripting.dictionary")
- Set sht = Sheets("源数据")
- arr = sht.Range("a1").CurrentRegion
- n = UBound(arr)
- [a2:n65536].ClearContents
- brr = Range("a1").CurrentRegion
- For j = 1 To UBound(arr, 2)
- d(arr(1, j)) = j
- Next
- For j = 1 To UBound(brr, 2)
- sht.Cells(2, d(brr(1, j))).Resize(n - 1, 1).Copy Cells(2, j)
- Next
- End Sub
复制代码 |
|