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

excelflower

原帖由 AVEL 于 2010-11-15 06:19 发表


能否在你运行完程序后 直接按照X2排序， 不按照G2排序。

这样的话，A、B班混排了。

excelflower

原帖由 AVEL 于 2010-11-15 05:41 发表
2个“本田2PS左外后门把手盖板彩喷(黑色毛坯件)”计划数量相加才是1个“本田2PS右外后门把手盖板彩喷(黑色毛坯件)”

针对前门把手 也是如此。

所以还需改进

2个“本田2PS左外后门把手盖板彩喷(黑色毛坯件)”：一个是A班的，一个是B班的，我的源数据中、这两个在同一班组中、不成对。
“本田2PS右外后门把手盖板彩喷(黑色毛坯件)”：这个在我的附件中、不存在。

excelflower

哈哈！哈哈！！哈哈 哈！我终于学会了VBA自定义序列的应用
老高兴了 谢谢楼主的问题

下面的代码，结果与72楼的一样！（没有VBA的Application.AddCustomList ListArray，咱也整得出来 ，我才知道：这就叫“成就感” ）

1. Sub MySort2()
   
2.     Dim i&, k&, Arr, MyStrA$, n&
   
3.     Dim J&, Crr, Brr, Drr, Dic As Object, MyKey, MyD As Object
   
4.     '取得排序值
   
5.     Application.ScreenUpdating = False
   
6.     Application.Calculation = xlManual
   
7.     k = Range("k65536").End(3).Row
   
8.     Arr = Range("k2:k" & k)
   
9.     ReDim Preserve Arr(1 To k - 1, 1 To 2)
   
10.     For i = 1 To UBound(Arr)
    
11.         MyStrA = Arr(i, 1)
    
12.         If InStr(1, MyStrA, "左") Then
    
13.             Arr(i, 1) = Replace(Arr(i, 1), "左", "")
    
14.         ElseIf InStr(1, MyStrA, "右") Then
    
15.             Arr(i, 1) = Replace(Arr(i, 1), "右", "")
    
16.         End If
    
17.     Next i
    
18.     [X2].Resize(UBound(Arr), 2) = Arr
    
19.     '物料名称字典
    
20.     Set Dic = CreateObject("Scripting.Dictionary")
    
21.     For J = 1 To UBound(Arr)
    
22.         If Not Dic.exists(Arr(J, 1)) Then Dic.Add Arr(J, 1), Nothing
    
23.     Next J
    
24.     Application.AddCustomList ListArray:=Dic.keys
    
25.     Range("A1").Sort Key1:=Range("X1"), _
    
26.                 Order1:=xlAscending, Header:=xlYes, _
    
27.                 OrderCustom:=Application.CustomListCount + 1
    
28.     Application.DeleteCustomList ListNum:=Application.CustomListCount
    
29.     Range("A1:Y" & k).Sort Key1:=Range("G1"), Order1:=xlAscending, Header:= _
    
30.         xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    
31.         SortMethod:=xlPinYin, DataOption1:=xlSortNormal, DataOption2:= _
    
32.         xlSortNormal, DataOption1:=xlSortNormal
    
33.     Application.Calculation = xlCalculationAutomatic
    
34.     Application.ScreenUpdating = True
    
35.     MsgBox ("哈哈哈，搞好了！")
    
36. End Sub
    

复制代码

yanjinwu

花朵姐姐,这么早呀,我先试一下,谢谢了

yanjinwu

那个还没搞对哦,那个有左前和左后还有右的

yanjinwu

像那个2PS的,应该是在一起的,2PX的也是在一起的,但是上面还差一点点,2PS的和2PX的合在一起了,应该还要加个条件,条件是名称一样的只是左右不一样的的应该在一起,

excelflower

原帖由 yanjinwu 于 2010-11-15 08:29 发表
那个还没搞对哦,那个有左前和左后还有右的

哈哈，我只搞了“左”和“右”。其它的，你就照葫芦画瓢吧。

yanjinwu

真不好意思呀,搞的这么多人在这里为我头痛

excelflower

楼主不断的进步啊 ，都盖到87层了，你又要改主体结构

看看你的需求、是怎么写滴：

excelflower

原帖由 yanjinwu 于 2010-11-15 08:30 发表
像那个2PS的,应该是在一起的,2PX的也是在一起的,但是上面还差一点点,2PS的和2PX的合在一起了,应该还要加个条件,条件是名称一样的只是左右不一样的的应该在一起,

你不是先分班组吗？你的数据源、有不成对的，一个班里、只有左，或只有右。所以才这样。