[求助]惭愧啊！遇到这个貌似很简单的问题，不会做了！相同行合计并删除！

ab30 · 发表于 2008-1-29 00:54

大汗！已经毕业了，但是遇到问题不会了！

TLAhDgjf.rar (5.06 KB, 下载次数: 27)

wayy · 发表于 2008-1-29 08:17

不知道用分类汇总可不可以，试一下吧。

ab30 · 发表于 2008-1-29 13:52

想用VBA做啊！下不了手了！[em01]

红岩铺 · 发表于 2008-1-30 21:04

学习

zjxia889 · 发表于 2008-2-5 14:45

Sub 分类汇总() Application.ScreenUpdating = False  Dim k&, m&, name$, l%, n%  Dim d As Object  Set d = CreateObject("SCRIPTING.dictionary")  Dim arr  arr = ActiveSheet.UsedRange.Value  m = UBound(arr)  l = UBound(arr, 2)  For k = 1 To m     d(arr(k, 1)) = arr(k, 2)  Next k  Sheets.Add  name = ActiveSheet.name  Range("a1").Resize(d.Count) = Application.Transpose(d.Keys)  Range("b1").Resize(d.Count) = Application.Transpose(d.Items)  For n = 3 To l   d.RemoveAll    For k = 1 To m     d(arr(k, 1)) = d(arr(k, 1)) + arr(k, n)    Next k   Cells(1, n).Resize(d.Count) = Application.Transpose(d.Items)  Next n  Set d = Nothing Application.ScreenUpdating = True End Sub

WQJHDaBq.rar (14.5 KB, 下载次数: 18)

laosanjie · 发表于 2008-2-5 15:28

<div class="msgheader">QUOTE:</div><div class="msgborder">以下是引用zjxia889在2008-2-5 14:45:00的发言： Sub 分类汇总() Application.ScreenUpdating = False  Dim k&, m&, name$, l%, n%  Dim d As Object  Set d = CreateObject("SCRIPTING.dictionary")  Dim arr  arr = ActiveSheet.UsedRange.Value  m = UBound(arr)  l = UBound(arr, 2)  For k = 1 To m     d(arr(k, 1)) = arr(k, 2)  Next k  Sheets.Add  name = ActiveSheet.name  Range("a1").Resize(d.Count) = Application.Transpose(d.Keys)  Range("b1").Resize(d.Count) = Application.Transpose(d.Items)  For n = 3 To l   d.RemoveAll    For k = 1 To m     d(arr(k, 1)) = d(arr(k, 1)) + arr(k, n)    Next k   Cells(1, n).Resize(d.Count) = Application.Transpose(d.Items)  Next n  Set d = Nothing Application.ScreenUpdating = True End Sub </div>[em17][em17][em17]  学习了！

		自动登录	找回密码
密码			注册