如何按照一个工作簿内容在另一工作簿显示出来是我要的固定格式_百度知 ...

发布网友 发布时间：2024-10-23 22:36

我来回答

共1个回答

热心网友 时间：2024-11-18 01:04

1，test.xls需另存为test.xlsm
2,reference.xlsx需另存为reference.xlsm 因为需要运行宏
3，建议增加字段名，操作运算容易
4，代码放在reference.xlsm
5代码功能：从TEST表中把与REFERENCE对应的第一列中序列号相同的相关信息连同对应的序列号导出到表reference.xlsm中

Sub AdoTs()

Dim Cnn
Dim Sql As String

Set Cnn = CreateObject("ADODB.Connection")

'HDR=no 无标题栏
Cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\test.xlsm;Extended Properties='Excel 12.0 Macro;HDR=no';"

Sql = "select aa.* from [Sheet1$a:j] as aa INNER JOIN [Excel 12.0;DATABASE=" & ThisWorkbook.FullName & ";HDR=no;].[Sheet1$] as bb ON aa.f1=bb.f1; "
'结果放到表2
Sheet2.Range("a1").CopyFromRecordset Cnn.Execute(Sql)
'关闭连接
Cnn.Close
'释放内存
Set Cnn = Nothing

End Sub

热心网友 时间：2024-11-18 01:06

1，test.xls需另存为test.xlsm
2,reference.xlsx需另存为reference.xlsm 因为需要运行宏
3，建议增加字段名，操作运算容易
4，代码放在reference.xlsm
5代码功能：从TEST表中把与REFERENCE对应的第一列中序列号相同的相关信息连同对应的序列号导出到表reference.xlsm中

Sub AdoTs()

Dim Cnn
Dim Sql As String

Set Cnn = CreateObject("ADODB.Connection")

'HDR=no 无标题栏
Cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\test.xlsm;Extended Properties='Excel 12.0 Macro;HDR=no';"

Sql = "select aa.* from [Sheet1$a:j] as aa INNER JOIN [Excel 12.0;DATABASE=" & ThisWorkbook.FullName & ";HDR=no;].[Sheet1$] as bb ON aa.f1=bb.f1; "
'结果放到表2
Sheet2.Range("a1").CopyFromRecordset Cnn.Execute(Sql)
'关闭连接
Cnn.Close
'释放内存
Set Cnn = Nothing

End Sub