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

yyyjianchao

如题。

同工作簿中两张工作表，因为功能不一样，所以内置的表头内容大部分相同，但是所在列的不一致，实际有起码40列，如何将数据中按表头复制到目标工作表。
最大列有可能扩展。

相同顺序表头不适用，因使用目的不一样。

谢谢！

附件内有赵版主以前的示例，不过是不同工作簿的，问题是需要手动做对应，实际工作表表头以及内容会有增减。

思路如下：1、创建  "数组1"   对应   "目标"工作表    表头所在列标                   与 "数组2"   对应   "数据"工作表    表头所在列标
2、根据 "目标"工作表 表头从第二列开始逐个查找数据工作表表头，查找到放入"数组2"（在这里怎么对应是个问题，另外需要考虑不存在的表头怎么处理）
3、逐个列赋值数据。

aman1516

随意隐藏或导出指定列
http://club.excelhome.net/thread-1245145-1-1.html

opel-wong

楼主太随意了，不上传附件，而且连附件模拟也是很随意的，你这样是得不到有效解答的。

准提部林

先用字典記錄標題列位置+array處理
或用find, match都可以找到相對應列再直接粘貼, 速度較慢罷!!

yyyjianchao

开始不知道怎么上传附件，现在上传了，请各位大神在帮忙看看

yyyjianchao

opel-wong 发表于 2020-8-28 10:10
楼主太随意了，不上传附件，而且连附件模拟也是很随意的，你这样是得不到有效解答的。

开始上传不了EXCEL ,只能传了图片，现在上传了压缩的excel。

yyyjianchao

3190496160 发表于 2020-8-28 09:33
如果两个工作表的列标题字段是一致的，只是顺序不同，或者说，有些表头不需要，字典匹配即可搞定的呀

帮忙写一下，我还在学习.

yyyjianchao

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

帮忙写一下代码，已经上传附件，行数不固定。

xiangbaoan

1. Sub test()
   
2.   Dim Cn As Object, Sq As String, ar, i As Long
   
3.   Set Cn = CreateObject("ADODB.Connection")
   
4.   If Application.Version < 12 Then
   
5.     Cn.Open "Provider=Microsoft.JET.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName
   
6.   Else
   
7.     Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
   
8.   End If
   
9.   Worksheets("目标").Activate
   
10.   ActiveSheet.UsedRange.Offset(1).ClearContents
    
11.   ar = Range(Range("A1"), Cells(1, Columns.Count).End(xlToLeft))
    
12.   For i = 1 To UBound(ar, 2)
    
13.     If Len(ar(1, i)) > 0 Then Sq = Sq & ",[" & ar(1, i) & "]" Else Sq = Sq & ",NULL"
    
14.   Next
    
15.   Sq = "SELECT " & Mid(Sq, 2) & " FROM [数据$]"
    
16.   Range("A2").CopyFromRecordset Cn.Execute(Sq)
    
17.   Cn.Close
    
18.   Set Cn = Nothing
    
19. End Sub

复制代码