stillfish00

回復 4# aa7551
114-1913F1A-VC  也算在成品嗎?

stillfish00

回復 11# aa7551
這樣判斷你看結果符不符合

1. Sub test()
   
2. Dim ar, s, ss, d1, d2
   
3. Set d1 = CreateObject("scripting.dictionary")
   
4. Set d2 = CreateObject("scripting.dictionary")
   
5. 
   
6. With Sheets(1)
   
7.     ar = .Range(.[a2], .[a2].End(xlDown)).Value
   
8.     For Each s In ar
   
9.         '成品
   
10.         If s Like "???-????L*" Then
    
11.             d1.Item(s) = ""
    
12.             ss = Left(s, 8) & "R" & Mid(s, 10)
    
13.             If d1.exists(ss) Then d1.Remove (ss)
    
14.         End If
    
15.         If s Like "???-????R*" Then '非成對保留
    
16.             If Not d1.exists(Left(s, 8) & "L" & Mid(s, 10)) Then d1.Item(s) = ""
    
17.         End If
    
18.         
    
19.         '零件
    
20.         If s Like "??????-????L*" Then
    
21.             d2.Item(s) = ""
    
22.             ss = Left(s, 11) & "R" & Mid(s, 13)
    
23.             If d2.exists(ss) Then d2.Remove (ss)
    
24.         End If
    
25.         If s Like "??????-????R*" Then '非成對保留
    
26.             If Not d2.exists(Left(s, 11) & "L" & Mid(s, 13)) Then d2.Item(s) = ""
    
27.         End If
    
28.     Next
    
29.     .[k2].Resize(d1.Count) = Application.Transpose(d1.keys)
    
30.     .[n2].Resize(d2.Count) = Application.Transpose(d2.keys)
    
31. End With
    
32. Set d1 = Nothing: Set d2 = Nothing
    
33. End Sub

複製代碼

stillfish00

回復 18# aa7551

1. Sub test()
   
2. Dim ar, s5s6, s8s9, s, d1, d2
   
3. Set d1 = CreateObject("scripting.dictionary")
   
4. Set d2 = CreateObject("scripting.dictionary")
   
5. 
   
6. With Sheets(1)
   
7.     ar = .Range(.[a2], .[a2].End(xlDown)).Value
   
8.     For Each s In ar
   
9.         s5s6 = Mid(s, 5, 2)
   
10.         If Mid(s, 4, 1) = "-" And (s5s6 = "11" Or s5s6 = "17" Or s5s6 = "20" Or s5s6 = "25" Or s5s6 = "37") Then d1.Item(s) = ""
    
11.             
    
12.         s8s9 = Mid(s, 8, 2)
    
13.         If Mid(s, 7, 1) = "-" And (s8s9 = "11" Or s8s9 = "20") Then d2.Item(s) = ""
    
14.     Next
    
15.     For Each s In d1.keys
    
16.         If Mid(s, 9, 1) = "R" And d1.exists(Left(s, 8) & "L" & Mid(s, 10)) Then
    
17.             d1.Remove (s)
    
18.         End If
    
19.     Next
    
20.     For Each s In d2.keys
    
21.         If Mid(s, 12, 1) = "R" And d2.exists(Left(s, 11) & "L" & Mid(s, 13)) Then
    
22.             d2.Remove (s)
    
23.         End If
    
24.     Next
    
25.    
    
26.     .[k2].Resize(d1.Count) = Application.Transpose(d1.keys)
    
27.     .[n2].Resize(d2.Count) = Application.Transpose(d2.keys)
    
28. End With
    
29. Set d1 = Nothing: Set d2 = Nothing
    
30. End Sub

複製代碼