ExcelTip.Net留存知识帖 ---【注：附件之前被网盘供应商清空后，现已修复-现已修复-现已修复为本地下载！】
现在位置：首页 > E问E答 > Excel VBA > 如何用ADO合并多个工作表的多个单元格区域？

如何用ADO合并多个工作表的多个单元格区域？

作者：绿色风 分类： 时间：2022-08-17 浏览：133
楼主
水星钓鱼		 Q：如下图所示：

 
有多个工作表，每个工作表又有多个相同格式的单元格区域，现在需要在“汇总”工作表合并所有这些区域，并按照其中几个字段的顺序排序，该如何解决？
A：由于涉及到多个工作表的多个单元格区域，用ADO时可以将每个单元格区域定义名称，然后再用SQL的联合查询这些定义的名称。
总的代码如下：
  1. Option Explicit
  2. Public oName As Name
  3. Private sSql As String
  4. Public oWS As Worksheet
  5. Private arr() As String
  6. Private Sub CommandButton1_Click()
  7.     Dim oRecrodset
  8.     Dim sConStr As String
  9.     Dim i As Integer
  10.     sConStr = "Provider='Microsoft.Jet.OLEDB.4.0';Data Source=" & ThisWorkbook.FullName & ";Extended Properties='Excel 8.0;HDR=YES'"
  11.     Call xyf_DeleteNames
  12.     Call xyf_DefineName
  13.     If ThisWorkbook.Names.Count = 0 Then
  14.         MsgBox "没有数据要合并"
  15.     Else
  16.         Call xyf_GetSql
  17.         Set oRecrodset = CreateObject("ADODB.Recordset")
  18.         Set oWS = ThisWorkbook.Worksheets("汇总表")
  19.         oWS.UsedRange.Clear
  20.         With oRecrodset
  21.             .Open sSql, sConStr
  22.             For i = 1 To .Fields.Count
  23.                 oWS.Cells(1, i) = .Fields(i - 1).Name
  24.             Next
  25.             oWS.Cells(2, 1).CopyFromRecordset oRecrodset
  26.         End With
  27.         Set oRecrodset = Nothing
  28.     End If
  29. End Sub
  30.     Sub xyf_DefineName()
  31.         Dim oRng As Range
  32.         Dim i As Integer
  33.         Dim s1st As String
  34.         For Each oWS In ThisWorkbook.Worksheets
  35.             If oWS.Name <> "汇总表" Then
  36.                 With oWS.Range("a1:a6366")
  37.                     Set oRng = .Find(what:="产品料号")
  38.                     s1st = oRng.Address
  39.                     Do
  40.                         If oRng.CurrentRegion.Rows.Count > 1 Then
  41.                             ThisWorkbook.Names.Add "rng" & i + 1, oRng.CurrentRegion
  42.                             ReDim Preserve arr(1 To i + 1)
  43.                             arr(i + 1) = "rng" & i + 1
  44.                             i = i + 1
  45.                         End If
  46.                         Set oRng = .FindNext(oRng)
  47.                     Loop While oRng.Address <> s1st
  48.                 End With
  49.             End If
  50.         Next oWS
  51. End Sub
  52. Sub xyf_GetSql()
  53.     sSql = ""
  54.     sSql = "select * from (select * from " & Join(arr, " union all select * from ") & ") order by 1,2,4,3"
  55. End Sub
  56. Sub xyf_DeleteNames()
  57.      For Each oName In ThisWorkbook.Names
  58.         oName.Delete
  59.     Next oName
  60. End Sub
附件如下：

合并多个工作表的多个单元格区域.rar
2楼
xyf2210		 谢谢分享
3楼
老糊涂		 谢谢分享
4楼
yytax2010		 ADO好               

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素， 经与ExcelTip.Net站长Apolloh商议并征得其同意， 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示， 供有需要的人士查询使用，也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议， 可与本人沟通提出，或于本站点留言，我们会尽快处理。 在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

猜您喜欢
评论列表
搜索

鄂ICP备2021011689号-2

powered by emlog pro Theme By 蓝叶

sitemap