[已解决]求排序代码

mjola1 · 发表于 2016-12-7 23:33

要求很简单：
将C列排成F列样子就行！一句话，损数据在上面，盈数据在下面，其它都不管。

最佳答案

上清宫主

2016-12-8 14:36

固定只要12000和3000数据，如有多的则略去。剪切的事没管
Sub test2()
Dim ar1(), ar2()
i1% = [c65536].End(3).Row
ar1 = [c1].Resize(i1).Value
ReDim ar2(1 To 3000, 1 To 1)
For i1% = 1 To UBound(ar1)
If Right(ar1(i1, 1), 1) = "损" Then
If i2% < 12000 Then i2 = i2 + 1: ar1(i2, 1) = ar1(i1, 1)
Else
If i3% < 3000 Then i3 = i3 + 1: ar2(i3, 1) = ar1(i1, 1)
End If
Next
Range("a1:a" & i3) = ar2
Range("c:c").Clear
Range("c1:c" & i2) = ar1
End Sub

跳转到最佳答案楼层

砂海 · 发表于 2016-12-8 06:45

辅助列d2
=right(c2)
下拉

然后选中整体数据 , 升序降序随你

苏子龙 · 发表于 2016-12-8 06:58

下面第三个怎么也有个损字，提问上传表格的好！

mjola1 · 发表于 2016-12-8 07:23

1.rar (7.16 KB, 下载次数: 9)

mjola1 · 发表于 2016-12-8 07:24

要完整代码

望帝春心 · 发表于 2016-12-8 08:14

感觉有点难啊，围观一下

望帝春心 · 发表于 2016-12-8 09:08

Sub Greenhand()
Dim i&, arr, brr()
Application.ScreenUpdating = False
arr = [c1].CurrentRegion.Value
[f1].Resize(UBound(arr), 1) = arr
ReDim brr(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
If Right(arr(i, 1), 1) = "盈" Then
brr(i, 1) = 2 * 10 ^ 4 + Split(Left(arr(i, 1), Len(arr(i, 1)) - 1), "-")(0) * 10 ^ 3 + _
Split(Left(arr(i, 1), Len(arr(i, 1)) - 1), "-")(1) * 10 ^ 2 + Split(Left(arr(i, 1), Len(arr(i, 1)) - 1), "-")(2) _
* 10 ^ 1 + Split(Left(arr(i, 1), Len(arr(i, 1)) - 1), "-")(3) * 10 ^ 0
Else
brr(i, 1) = 10 ^ 4 + Split(Left(arr(i, 1), Len(arr(i, 1)) - 1), "-")(0) * 10 ^ 3 + _
Split(Left(arr(i, 1), Len(arr(i, 1)) - 1), "-")(1) * 10 ^ 2 + Split(Left(arr(i, 1), Len(arr(i, 1)) - 1), "-")(2) _
* 10 ^ 1 + Split(Left(arr(i, 1), Len(arr(i, 1)) - 1), "-")(3) * 10 ^ 0
End If
Next
[g1].Resize(UBound(arr), 1) = brr
Range("f:g").Sort Key1:=Range("g1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortNorma
Columns("g:g").Clear
Application.ScreenUpdating = True
End Sub

复制代码

上清宫主 · 发表于 2016-12-8 10:20

Sub test()
ar = [c1:c32]
For i% = 1 To UBound(ar)
ar(i, 1) = Right(ar(i, 1), 1)
Next
[d1].Resize(i - 1) = ar
[c1].Resize(i - 1, 2).Sort [d1]
[d1].Resize(i - 1).Clear
End Sub

苏子龙 · 发表于 2016-12-8 10:49

Sub tt()
Dim arr, i%, n%, s%, y%, brr
arr = Range("c1").CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 2)
For i = 1 To UBound(arr)
If Right(arr(i, 1), 1) = "损" Then
n = n + 1
brr(i, 1) = i + n * 100
End If
Next
For i = 1 To UBound(arr)
If brr(i, 1) > 100 Then
s = s + 1
brr(s, 2) = arr(i, 1)
Else
y = y + 1
brr(n + y, 2) = arr(i, 1)
End If
Next
Range("g1").Resize(UBound(arr), 1) = Application.Index(brr, , 2)
End Sub
凑个热闹

复制代码

mjola1 · 发表于 2016-12-8 11:00

望帝春心发表于 2016-12-8 09:08

新1.rar (39.42 KB, 下载次数: 3)

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

[已解决]求排序代码

评分