区域排序取数值的问题，谢谢！

zhaogang1960 · 发表于 2014-1-3 17:05

请测试附件

意甲-威廉.rar (48.42 KB, 下载次数: 11)

jinball · 发表于 2014-1-3 17:06

zhaogang1960 发表于 2014-1-3 16:58
使用Excel工作表排序法：

这个是可以的，真棒，完美了，我自己研究一下，再做几个试试，非常感谢！！！有问题我再跟您联系，对了我看您的资料是青岛出生的啊，老乡！

jinball · 发表于 2014-1-7 15:15

本帖最后由 jinball 于 2014-1-7 15:19 编辑

zhaogang1960 发表于 2014-1-3 17:05
请测试附件

版主，这个排序规则是在变化的呀，能不能定义一下排序规则？有时候数据大小会一样！再次麻烦您！

zhaogang1960 · 发表于 2014-1-7 15:18

jinball 发表于 2014-1-7 15:15
版主，这个排序规则是在变化的呀，能不能定义一下排序规则？

简单升序排序，没有任何另外排序规则
.Cells(i, 1).Resize(10, 13).Sort Key1:=.Cells(i, 9), Order1:=1, Header:=xlNo

jinball · 发表于 2014-1-7 15:24

zhaogang1960 发表于 2014-1-7 15:18
简单升序排序，没有任何另外排序规则
.Cells(i, 1).Resize(10, 13).Sort Key1:=.Cells(i, 9), Order1:=1 ...

版主，是这样的，这个表格我是用来做统计的，因为Sheet1中的数据是不断添加的，那么每次添加我都要重新依次点击Sheet2\Sheet3\Sheet4中的按钮进行更新，但是每次点击的时候我发现由于排序规则不固定，前面数据每次点击都会发生变化，这会不会影响我统计效果？我主要担心这个。

zhaogang1960 · 发表于 2014-1-7 15:33

jinball 发表于 2014-1-7 15:24
版主，是这样的，这个表格我是用来做统计的，因为Sheet1中的数据是不断添加的，那么每次添加我都要重新依 ...

排序功能对原数据产生了干扰，改为复制Sheet1，仅对副本排序，缺点速度慢：

Sub Sheet2()
Dim arr, brr(1 To 1000, 0 To 10), i&, j&, m&, sh As Worksheet
Application.ScreenUpdating = False
Set sh = Sheets("Sheet2")
sh.Cells.Clear
Sheets("Sheet1").Copy
With ActiveSheet
For i = 1 To Sheets("Sheet1").Range("a" & Rows.Count).End(xlUp).Row Step 10
m = m + 1
.Cells(i, 1).Resize(10, 13).Sort Key1:=.Cells(i, 9), Order1:=1, Header:=xlNo
arr = .Cells(i, 12).Resize(10)
brr(m, 0) = "I" & i & ":L" & i + 9
For j = 1 To 10
brr(m, j) = arr(j, 1)
.Cells(i + j - 1, 12).Copy
sh.Cells(m, j + 1).PasteSpecial Paste:=xlPasteFormats
Next
Next
End With
ActiveWorkbook.Close False
sh.[a1].Resize(m, 11) = brr
Application.ScreenUpdating = True
End Sub
Sub Sheet3()
Dim arr, brr(1 To 1000, 0 To 10), i&, j&, m&, sh As Worksheet
Application.ScreenUpdating = False
Set sh = Sheets("Sheet3")
sh.Cells.Clear
Sheets("Sheet1").Copy
With ActiveSheet
For i = 1 To Sheets("Sheet1").Range("a" & Rows.Count).End(xlUp).Row Step 10
m = m + 1
.Cells(i, 1).Resize(10, 13).Sort Key1:=.Cells(i, 10), Order1:=1, Header:=xlNo
arr = .Cells(i, 12).Resize(10)
brr(m, 0) = "J" & i & ":L" & i + 9
For j = 1 To 10
brr(m, j) = arr(j, 1)
.Cells(i + j - 1, 12).Copy
sh.Cells(m, j + 1).PasteSpecial Paste:=xlPasteFormats
Next
Next
End With
ActiveWorkbook.Close False
sh.[a1].Resize(m, 11) = brr
Application.ScreenUpdating = True
End Sub
Sub Sheet4()
Dim arr, brr(1 To 1000, 0 To 10), i&, j&, m&, sh As Worksheet
Application.ScreenUpdating = False
Set sh = Sheets("Sheet4")
sh.Cells.Clear
Sheets("Sheet1").Copy
With ActiveSheet
For i = 1 To Sheets("Sheet1").Range("a" & Rows.Count).End(xlUp).Row Step 10
m = m + 1
.Cells(i, 1).Resize(10, 13).Sort Key1:=.Cells(i, 11), Order1:=1, Header:=xlNo
arr = .Cells(i, 12).Resize(10)
brr(m, 0) = "K" & i & ":L" & i + 9
For j = 1 To 10
brr(m, j) = arr(j, 1)
.Cells(i + j - 1, 12).Copy
sh.Cells(m, j + 1).PasteSpecial Paste:=xlPasteFormats
Next
Next
End With
ActiveWorkbook.Close False
sh.[a1].Resize(m, 11) = brr
Application.ScreenUpdating = True
End Sub

复制代码

zhaogang1960 · 发表于 2014-1-7 15:34

请测试附件

意甲-威廉.rar (44.86 KB, 下载次数: 3)

jinball · 发表于 2014-1-7 15:45

zhaogang1960 发表于 2014-1-7 15:34
请测试附件

oK！！！这次好了，就这样吧，慢点不要紧！
真是高手呀，太快了，非常感谢，另外尝试修改过代码不成功，还是看不明白，您再帮个忙吧，我添加三列数据，这次变成取P列的数值，我自己修改代码不成功，您帮忙给设置一下吧，最后一版了，真不好意思再麻烦您了

意甲-威廉.zip (46.74 KB, 下载次数: 3)

zhaogang1960 · 发表于 2014-1-7 15:57

jinball 发表于 2014-1-7 15:45
oK！！！这次好了，就这样吧，慢点不要紧！
真是高手呀，太快了，非常感谢，另外尝试修改过代码不成功， ...

不知道按照哪一列排序，取哪一列数据了，请说明

jinball · 发表于 2014-1-7 16:16

zhaogang1960 发表于 2014-1-7 15:57
不知道按照哪一列排序，取哪一列数据了，请说明

已经重新说明了，在Sheet2-Sheet8中有说明，谢谢版主！

意甲-威廉.zip (46.69 KB, 下载次数: 3)

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