大哥，帮我看一下这个，提供一下思路

excelflower

原帖由 yanjinwu 于 2010-11-12 10:35 发表
有没有大哥大姐们帮忙呀

呵呵，大姐帮忙了

1. Sub MySort()
   
2.     Dim i&, k&, Arr, MyStrA$
   
3.     Application.ScreenUpdating = False
   
4.     Application.Calculation = xlManual
   
5.     k = Range("k65536").End(3).Row
   
6.     Arr = Range("k1:k" & k)
   
7.     ReDim Preserve Arr(1 To k, 1 To 2)
   
8.     For i = 1 To UBound(Arr)
   
9.         MyStrA = Arr(i, 1)
   
10.         If InStr(1, MyStrA, "左") Then
    
11.             Arr(i, 1) = Replace(Arr(i, 1), "左", "")
    
12.             Arr(i, 2) = "左"
    
13.         ElseIf InStr(1, MyStrA, "右") Then
    
14.             Arr(i, 1) = Replace(Arr(i, 1), "右", "")
    
15.             Arr(i, 2) = "右"
    
16.         End If
    
17.     Next i
    
18.     Arr(1, 1) = "排序字段一"
    
19.     Arr(1, 2) = "排序字段二"
    
20.     [X1].Resize(k, 2) = Arr
    
21.     ActiveWorkbook.Worksheets("Sheet1 (2)").Sort.SortFields.Clear
    
22.     ActiveWorkbook.Worksheets("Sheet1 (2)").Sort.SortFields.Add Key:=Range( _
    
23.         "X2:X" & k), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    
24.         xlSortNormal
    
25.     ActiveWorkbook.Worksheets("Sheet1 (2)").Sort.SortFields.Add Key:=Range( _
    
26.         "Y2:Y" & k), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    
27.         xlSortNormal
    
28.     With ActiveWorkbook.Worksheets("Sheet1 (2)").Sort
    
29.         .SetRange Range("A1:Y" & k)
    
30.         .Header = xlYes
    
31.         .MatchCase = False
    
32.         .Orientation = xlTopToBottom
    
33.         .SortMethod = xlPinYin
    
34.         .Apply
    
35.     End With
    
36.     Application.Calculation = xlCalculationAutomatic
    
37.     Application.ScreenUpdating = True
    
38.     MsgBox ("搞好了！")
    
39. End Sub

复制代码

yanjinwu

谢谢呀，先测试一下

yanjinwu

说是对象不支持这属性和方法

excelflower

原帖由 yanjinwu 于 2010-11-12 11:26 发表
说是对象不支持这属性和方法

我是OFFICE2010,你是什么版本。

yanjinwu

2003版的呢，那需要改哪里

yanjinwu

姐姐呢？

excelflower

原帖由 yanjinwu 于 2010-11-12 11:34 发表
姐姐呢？

呵呵，这呢。试试这个......

excelflower

2003是这样

1. Sub MySort()
   
2.     Dim i&, k&, Arr, MyStrA$
   
3.     Application.ScreenUpdating = False
   
4.     Application.Calculation = xlManual
   
5.     k = Range("k65536").End(3).Row
   
6.     Arr = Range("k1:k" & k)
   
7.    ' ReDim Preserve Arr(1 To k, 1 To 2)
   
8.     For i = 1 To UBound(Arr)
   
9.         MyStrA = Arr(i, 1)
   
10.         If InStr(1, MyStrA, "左") Then
    
11.             Arr(i, 1) = Replace(Arr(i, 1), "左", "") & "左"
    
12.             'Arr(i, 2) = "左"
    
13.         ElseIf InStr(1, MyStrA, "右") Then
    
14.             Arr(i, 1) = Replace(Arr(i, 1), "右", "") & "右"
    
15.             'Arr(i, 2) = "右"
    
16.         End If
    
17.     Next i
    
18.     Arr(1, 1) = "排序字段一"
    
19.     [Y1].Resize(k, 1) = Arr
    
20.     Range("A1:Y" & k).Sort Key1:=Range("Y2"), Order1:=xlAscending, Header:=xlYes, _
    
21.         OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
    
22.         :=xlPinYin, DataOption1:=xlSortNormal
    
23.     Application.Calculation = xlCalculationAutomatic
    
24.     Application.ScreenUpdating = True
    
25.     MsgBox ("搞好了！")
    
26. End Sub

复制代码

yanjinwu

姐姐，真是人才呀，我先试下，你加我QQ好不

excelflower

原帖由 yanjinwu 于 2010-11-12 11:44 发表
姐姐，真是人才呀，我先试下，你加我QQ好不

抵制QQ，支持360