一个多列汇总问题，搜索资料还是无法解决。

zmhzmh1999 · 发表于 2011-7-8 11:21

一个多列汇总问题，搜索了论坛资料还是无法解决，请大家帮忙。

那么的帅 · 发表于 2011-7-8 11:37

回复 zmhzmh1999 的帖子

先把数据表的多余数据删除
执行下面的代码

Sub 汇总()
Dim arr1()
arr = Sheets("数据").UsedRange.Value
For i = 1 To UBound(arr)
For j = 1 To UBound(arr, 2)
If arr(i, j) <> "" Then
m = m + 1
ReDim Preserve arr1(1 To 1, 1 To m)
arr1(1, m) = arr(i, j)
End If
Next j
Next i
For i = 1 To m - 1
For j = i + 1 To m
If arr1(1, i) < arr1(1, j) Then
t = arr1(1, i)
arr1(1, i) = arr1(1, j)
arr1(1, j) = t
End If
Next j
Next i
Sheets("汇总").Columns("a:a").ClearContents
Sheets("汇总").Range("a1").Resize(m, 1) = Application.Transpose(arr1)
End Sub

复制代码

多列提取数据并排序(VBA).rar (13.68 KB, 下载次数: 10)

zmhzmh1999 · 发表于 2011-7-8 11:44

首先多谢前辈回帖帮忙，代码高效正确，但有时我需要计算大量数据，把数据页的数据一次读入内存会提示溢出无法运行，能写出逐列汇总的代码吗？感激不尽。

QLZ0602 · 发表于 2011-7-8 11:47

Sub Macro2()
'
' Macro2 Macro
' 宏由 000885 录制，时间: 2011-7-8
'

'
  Sheets("汇总").Columns("A:A").Clear
For i = 1 To Range("A1").End(xlToRight).Column
   Sheets("数据").Select
Range("A1:A" & Range("a65536").Offset(0, i).End(xlUp).Row).Offset(0, i).Select
Selection.Copy
Sheets("汇总").Select
Cells(Range("A65536").End(xlUp).Row + 1, 1).Select
ActiveSheet.Paste
Next i

   Columns("A:A").Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlGuess, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
      :=xlPinYin, DataOption1:=xlSortNormal
End Sub

sanbe · 发表于 2011-7-8 11:48

溢出是你超过了65535行了吧？

那么的帅 · 发表于 2011-7-8 11:54

回复 zmhzmh1999 的帖子

溢出的原因是不是超过65536行了，如果超过
请告知如何分列显示，每列显示多少行？

sanbe · 发表于 2011-7-8 12:02

本帖最后由 sanbe 于 2011-7-8 12:03 编辑

Sub test()
Dim intcol As Integer
Dim lngrow As Long
Dim lngcount As Long
lngcount = 1
For intcol = 1 To Sheet1.Range("A1").End(xlToRight).Column
For lngrow = 1 To Sheet1.Cells(65536, intcol).End(xlUp).Row
Sheet4.Cells(lngcount, 1) = Cells(lngrow, intcol)
lngcount = lngcount + 1
Next
Next
End Sub

复制代码

纯单元格循环，好多年没写这样的代码了{:4012:}

zmhzmh1999 · 发表于 2011-7-8 12:03

我用的是2007，最多时曾计算过过百万行的数据

，所用的代码都是逐列或逐行进行的

，感谢四楼的代码，正为所求，因为逐列计算，再大数据也不会溢出，谢谢前辈。不过能稍稍提点一下下面一句的步骤原理吗？本人菜鸟，看不太懂啊。。。
Range("A1:A" & Range("a65536").Offset(0, i).End(xlUp).Row).Offset(0, i).Select

zmhzmh1999 · 发表于 2011-7-8 12:12

感谢七楼版主大大的代码，能否问一下Sheet4.Cells(lngcount, 1) 句中为何是sheet4？可执行完却在sheet2中，为何？

那么的帅 · 发表于 2011-7-8 12:19

回复 zmhzmh1999 的帖子

多列提取数据并排序(VBA)-1.rar (276.59 KB, 下载次数: 20)

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