字段不完全相同的多个工作簿按工作表名汇总[已小结]

筱悠

太精彩了！留个记号反复看，一次看不明白啊！

czjcjt

长见识了，此题稍加修改可变为多工作簿复杂汇总通用工具。

song22602

老师：我有个问题想请你指导：

Private Sub UserForm_Initialize()
    pp = 15: mm = 5 'pp:多少列  mm:第几列为查找号
    Dim SQL$, i&, j&, Arr, a()
    With Sheets("数据库")
        Arr = .Range("A2").CurrentRegion
        ReDim a(UBound(Arr, 2) - 1)
         For i = 0 To UBound(a)
             a(i) = .Columns(i + 1).ColumnWidth * 7#  'ListView1各列列宽
         Next
    End With
    Set cnn = New ADODB.Connection  'jet  4 8
    cnn.Open "provider=microsoft.Ace.oledb.12.0;extended properties=excel 12.0;data source=" & ThisWorkbook.FullName
   
    SQL = "select * from [数据库$] "
    Set rs = New ADODB.Recordset
    rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    On Error Resume Next
    With ListView1
        '设置ListView1的标题、显示类型、整行选择和网格线属性
        .ColumnHeaders.Clear
        .View = lvwReport        '   listivew的显示格式为报表格式
        .FullRowSelect = True    '   允许整行选中
        .Gridlines = True        '   显示网格线
        '为ListView1设置标题
        For i = 0 To pp - 1 'rs.Fields.Count - 1
              .ColumnHeaders.Add , , rs.Fields(i).Name, a(i) ' a(i)
         Next i
    End With
    Call 显示数据(SQL)    '为ListView1设置各行数据

    模糊查询.SetFocus
End Sub

Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem) 'ListView1单击事件
    Dim i&
    TextBox1.Text = Item '首列数据赋给工号文本框
    ary(0) = Item '姓名存放到数组作为删除记录的姓名查询条件
    With ListView1
        For i = 1 To pp - 1 '逐列数据写入文本框
            Controls("TextBox" & i + 1) = .ListItems(Item.Index).SubItems(i)
        Next i
         ary(1) = .ListItems(Item.Index).SubItems(mm - 1)  'pp - 1) '“状态”存放到数组作为删除记录的工作单位查询条件
    End With
End Sub
就是你从前写的通讯录，我在想在窗体上增加一个取数据的工作表，其名为：升级记录，当姓名相同时，在ListView2显示升级记录的数据，并且，可以重复的，有几个显示多少？谢谢了！！

huayuyan

看不懂啊 太高深了！

darkbluecs

和我最近的工作内容有相似的地方，先mark，明天研究一下看看能不能搞懂

sjh701120

zhaogang1960 老师，能否帮我解决这个问题，将数据按类别分别添加到不同工作表和工作簿，vba怎么写？谢谢!

zxjjessica1988

这都是大神的杰作啊

jerrylam

这个用SQL也可以的

daphy123

xmyjk 发表于 2012-1-31 21:44
仅针对取表名和字段名的方法进行讨论，集合了42楼赵老师的意见再次又整理了下：

呵呵，我昨晚翻查了一 ...

好多干货   慢慢吸收

品瑶

zhaogang1960 发表于 2013-5-18 23:48
对你的判断我表示佩服，但你的判断是错误的，我没有精力和耐心“纯粹为了出题”来“表的重构”

下面是 ...

老师您好，这道题我最后输出到工作表的时候，用这个循环出错：
ThisWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count), Count:=k
For x = 1 To k
    Sheets(x + 1).Range("A1").Resize(dd(k), dcd(k)) = arr(k) ’dd、dcd是做的两个字典，用来记录arr(k)数组中的实际有数据的行列数
    Sheets(x + 1).Name = d.Keys()(x - 1)
Next x
只能用这样的笨方法才没出错：
   ThisWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count), Count:=k
    Sheets(2).Range("A1").Resize(dd(1), dcd(1)) = arr(1)
    Sheets(2).Name = d.Keys()(0)
    Sheets(3).Range("A1").Resize(dd(2), dcd(2))) = arr(2)
    Sheets(3).Name = d.Keys()(1)
    Sheets(4).Range("A1").Resize(dd(3), dcd(3)) = arr(3)
    Sheets(4).Name = d.Keys()(2)
    Sheets(5).Range("A1").Resize(dd(4), dcd(4)) = arr(4)
    Sheets(5).Name = d.Keys()(3)
请问一下我那个出错的代码错在哪里了呢？谢谢！