|
|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
哈哈！哈哈！！哈哈 哈！我终于学会了VBA自定义序列的应用
老高兴了 谢谢楼主的问题
下面的代码，结果与72楼的一样！（没有VBA的Application.AddCustomList ListArray，咱也整得出来 ，我才知道：这就叫“成就感” ）- Sub MySort2()
- Dim i&, k&, Arr, MyStrA$, n&
- Dim J&, Crr, Brr, Drr, Dic As Object, MyKey, MyD As Object
- '取得排序值
- Application.ScreenUpdating = False
- Application.Calculation = xlManual
- k = Range("k65536").End(3).Row
- Arr = Range("k2:k" & k)
- ReDim Preserve Arr(1 To k - 1, 1 To 2)
- For i = 1 To UBound(Arr)
- MyStrA = Arr(i, 1)
- If InStr(1, MyStrA, "左") Then
- Arr(i, 1) = Replace(Arr(i, 1), "左", "")
- ElseIf InStr(1, MyStrA, "右") Then
- Arr(i, 1) = Replace(Arr(i, 1), "右", "")
- End If
- Next i
- [X2].Resize(UBound(Arr), 2) = Arr
- '物料名称字典
- Set Dic = CreateObject("Scripting.Dictionary")
- For J = 1 To UBound(Arr)
- If Not Dic.exists(Arr(J, 1)) Then Dic.Add Arr(J, 1), Nothing
- Next J
- Application.AddCustomList ListArray:=Dic.keys
- Range("A1").Sort Key1:=Range("X1"), _
- Order1:=xlAscending, Header:=xlYes, _
- OrderCustom:=Application.CustomListCount + 1
- Application.DeleteCustomList ListNum:=Application.CustomListCount
- Range("A1:Y" & k).Sort Key1:=Range("G1"), Order1:=xlAscending, Header:= _
- xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
- SortMethod:=xlPinYin, DataOption1:=xlSortNormal, DataOption2:= _
- xlSortNormal, DataOption1:=xlSortNormal
- Application.Calculation = xlCalculationAutomatic
- Application.ScreenUpdating = True
- MsgBox ("哈哈哈，搞好了！")
- End Sub
|
|
楼主: yanjinwu
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2010-11-15 06:22
楼主
