关于vb循环将多行数据集动态抽取特定字段数据按列排列保存到excel中

[松鼠大乱斗]

这是我数据库中的表

这是我表的格式
现在我用模糊查询到了表格，然后又查询了字段

这是我模糊查询了一个表格显示的数据
现在我想让数据像这样显示

用vb的代码如何实现？
就是让excel每读取一张表就自动换列，纪录集里面的数据自动添加到原有的excel文件中最右侧
由于数据量比较大，就用了表格复制的方式

    Dim Con As ADODB.Connection
     Dim sql0 As String
     Dim strtemp As String
    Dim My_temp As New ADODB.Recordset
    Dim Name() As String
    
    strtemp = "Provider=SQLOLEDB;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=MyTest;Data Source=珞珈风云1-PC\SQLEXPRESS;"
   ' Con.Open strtemp
    
   ' s = OName(Name()) '部分数据
      
  '  sql0 = "SELECT [日期] ," & "[" & TextColums.Text & "]" & " from  sysobjects Where Name  like " & " '%" & Name(4, 1) & "%'" & " and [日期] > '" & TextTB.Text & "' and [日期] < '" & TextTE.Text & "'"

  sql0 = "declare @searchTables nvarchar(100)  set @searchTables = '%SH000001" _
        & "' declare @sqlCommand nvarchar(4000) set @sqlCommand = '' " _
        & "declare @dateB varchar(10) set @dateB = " & TextTB.Text _
       & "declare @dateE varchar(100) set @dateE = " & TextTE.Text _
       & ";with tableNames as ( select all 'select [日期],[成交额] from [MyTest].[dbo].[' + Name + '] where [日期] >= '''  + @dateB +   ''' and [日期] <= '''  + @dateE + '''' as SelectTable from sys.tables where name like @searchTables) " _
       & " select @sqlCommand = @sqlCommand + SelectTable from tableNames exec (@sqlCommand)"
       My_temp.Open sql0, strtemp, adOpenKeyset, adLockOptimistic
 
    Set mExcelFile = CreateObject("Excel.Sheet")
   mExcelFile.Application.Range("A1").CopyFromRecordset My_temp
   mExcelFile.SaveAs "G:\123.xls"
   Set mExcelFile = Nothing

 My_temp.Close

当然也可以先用临时表合并的方式，然后再将临时表复制到excel。
大神求教

[松鼠大乱斗]

补充：TextTB.Text与TextTE.Text是我的编辑框控件。

[X-i-n]

所以，你的问题是什么？

[松鼠大乱斗]

引用 2 楼 Runnerchin 的回复:

所以，你的问题是什么？

就是如题，根据条件读取一张表的【日期】【成交额】两列，然后写入excel的A2，B2中,之后在读一张表的【日期】【成交额】两列，之后写入同一个excel表中C2，D2中，这样一直循环，写完所有的查询。然后分别在A1，C1中插入相应的表名。

[X-i-n]

这个流程没问题，但是……你的问题是什么？

[松鼠大乱斗]

引用 4 楼 Runnerchin 的回复:

这个流程没问题，但是……你的问题是什么？

如何用vb的代码实现上面说的功能，我实现了单表的字段读取，接下来的代码 一个循环根据数组中的表名读表，一个是excel的换列的代码如何实现

[X-i-n]

梳理一下整个流程，把你要做的事列出来，然后一项一项完成，就和搭积木一样。 我大概说一下吧： 查询出数据库里所有的表(怎么查询指定数据库里的所有数据表) 循环每张表 根据表名判断是不是你需要的表 如果是符合要求的表，读出表数据，写到excel，写的时候，每张新表使用新的EXCEL数据列（怎么取查询结果，怎么把数据写到EXCEL的指定位置） 循环结束后，保存工作簿（怎么保存工作簿 ） 第N张表的粘贴起始位置是

Cells((N - 1 ) * 2 + 1 , 1)

所以在查询完毕以后，可以用

    Dim FirstCell As Range
    Set FirstCell = Cells((tblNo - 1) * 2 +1, 1)

来确定你的第N张表的起始位置并从此处开始粘贴表 查询过程写得过于复杂了 非常想吐槽你的EXCEL表结构，横向排列的话，数据处理会很痛苦，比如做数据透视，建议竖向导入数据，后续处理会比较轻松。

[松鼠大乱斗]

好的谢谢

引用 6 楼 Runnerchin 的回复:

梳理一下整个流程，把你要做的事列出来，然后一项一项完成，就和搭积木一样。 我大概说一下吧： 查询出数据库里所有的表(怎么查询指定数据库里的所有数据表) 循环每张表 根据表名判断是不是你需要的表 如果是符合要求的表，读出表数据，写到excel，写的时候，每张新表使用新的EXCEL数据列（怎么取查询结果，怎么把数据写到EXCEL的指定位置） 循环结束后，保存工作簿（怎么保存工作簿 ） 第N张表的粘贴起始位置是

Cells((N - 1 ) * 2 + 1 , 1)

所以在查询完毕以后，可以用

    Dim FirstCell As Range
    Set FirstCell = Cells((tblNo - 1) * 2 +1, 1)

来确定你的第N张表的起始位置并从此处开始粘贴表 查询过程写得过于复杂了 非常想吐槽你的EXCEL表结构，横向排列的话，数据处理会很痛苦，比如做数据透视，建议竖向导入数据，后续处理会比较轻松。

我用的是

   mExcelFile.Application.Range("A1").CopyFromRecordset My_temp.NextRecordset(RecordAffected)

复制的方法给excel赋值，但是没有使用cell的参数的函数，我怎样能将cell换为A1的形式

[X-i-n]

cells(3,1).address