ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 3497|回复: 12

[求助] 求助如何按指定的列进行数据汇总?

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-6-12 11:41 | 显示全部楼层 |阅读模式
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
有若干条数据,A列条码相同的为一组,要将B列的数据相加,其余的保留最后一列为main的数据,详细见附件,求教汇总方法

汇总.rar

7.44 KB, 下载次数: 73

TA的精华主题

TA的得分主题

发表于 2019-6-12 12:06 | 显示全部楼层
'假设A列有序,,,

Option Explicit

Sub test()
  Dim arr, i, j, p, m, sum
  arr = [a1].CurrentRegion.Offset(1).Resize(, 8)
  For i = 1 To UBound(arr, 1) - 1
    sum = sum + arr(i, 2)
    If arr(i, 8) = "main" Then p = i
    If arr(i, 1) <> arr(i + 1, 1) Then
      If p = 0 Then MsgBox "main": Exit Sub
      m = m + 1: arr(m, 1) = arr(i, 1): arr(m, 2) = sum
      For j = 3 To 8: arr(m, j) = arr(p, j): Next
      p = 0: sum = 0
    End If
  Next
  With [k2]
    .Resize(Rows.Count - 1, 8).ClearContents
    If m > 0 Then .Resize(m, 8) = arr
  End With
End Sub

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-6-12 13:39 | 显示全部楼层
一把小刀闯天下 发表于 2019-6-12 12:06
'假设A列有序,,,

Option Explicit

A列是无序的呢?不好意思,怪我没说清楚

TA的精华主题

TA的得分主题

发表于 2019-6-12 14:09 | 显示全部楼层
本帖最后由 740688321 于 2019-6-12 14:12 编辑
  1. Option Explicit
  2. Sub MySum()
  3.     Dim cnn As Object, sql$, c%
  4.     Set cnn = CreateObject("ADODB.Connection")
  5.     cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
  6.     '''标题1   标题2   标题3   标题4   标题5   标题6   标题7   标题8
  7.     For c = 1 To 3
  8.         sql = "select sum(标题2) from [Sheet1$a1:B10] where 标题1= " & "1000" & c
  9.         Cells(Rows.Count, "I").End(xlUp).Offset(1).CopyFromRecordset cnn.Execute(sql)
  10.     Next
  11.     cnn.Close
  12.     Set cnn = Nothing
  13. End Sub
复制代码
1.png

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-6-12 14:25 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-6-12 14:57 | 显示全部楼层
Option Explicit
Sub test()
Dim d As Object, ar, i&, j&, k&, s$
Set d = CreateObject("Scripting.Dictionary")
ar = [a1].CurrentRegion.Resize(, 8)
ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
k = 1
For j = 1 To UBound(ar, 2)
    br(k, j) = ar(1, j)
Next
For i = 2 To UBound(ar)
    s = ar(i, 1)
    d(s) = d(s) + ar(i, 2)
    If LCase(ar(i, UBound(ar, 2))) = "main" Then
        k = k + 1
        br(k, 1) = s
        For j = 3 To UBound(ar, 2)
            br(k, j) = ar(i, j)
        Next
    End If
Next
For i = 2 To k
    br(i, 2) = d(br(i, 1))
Next
[a14].Resize(k, UBound(br, 2)) = br
Set d = Nothing
End Sub

评分

2

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-6-12 16:09 | 显示全部楼层
xiangbaoan 发表于 2019-6-12 14:57
Option Explicit
Sub test()
Dim d As Object, ar, i&, j&, k&, s$

万分感谢,这就是我要的答案

TA的精华主题

TA的得分主题

发表于 2019-6-12 17:01 | 显示全部楼层
lovelfg 发表于 2019-6-12 14:25
您的代码只能求和B列,不是我要的结果哟

Option Explicit
Sub MySum()
    Dim cnn As Object, sql$, c%
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
    '''标题1   标题2   标题3   标题4   标题5   标题6   标题7   标题8
    For c = 1 To 3
        sql = "select sum(标题2) from [Sheet1$a1:H10] where 标题1=1000" & c
        Cells(Rows.Count, "B").End(xlUp).Offset(1).CopyFromRecordset cnn.Execute(sql)
        sql = "select 标题3,标题4,标题5,标题6,标题7,标题8 from [Sheet1$a1:H10] where 标题8='main'and 标题1=1000" & c
        Cells(Rows.Count, "C").End(xlUp).Offset(1).CopyFromRecordset cnn.Execute(sql)
        sql = "select 标题1 from [Sheet1$a1:H10] where 标题8='main'and 标题1=1000" & c
        Cells(Rows.Count, "A").End(xlUp).Offset(1).CopyFromRecordset cnn.Execute(sql)
    Next
    cnn.Close
    Set cnn = Nothing
End Sub

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-6-12 17:17 | 显示全部楼层
740688321 发表于 2019-6-12 17:01
Option Explicit
Sub MySum()
    Dim cnn As Object, sql$, c%

厉害!这次对了

TA的精华主题

TA的得分主题

发表于 2019-6-12 17:44 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-28 20:36 , Processed in 0.064163 second(s), 11 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表