VBA 程式修改(跳过栏位)

spp0063

是否可协助修改VBA 程式(跳过M2 & W栏位)
程式执行说明:
当按下Output "Find" 执行案键,跳过M2 & W栏位

1. Private Sub Sel(xstr)
   
2.     Dim i, j, jj, k, x, lotno
   
3.     Dim ToRange As Range
   
4.     Dim tmpArr(), n(), Arr
   
5.     With Worksheets(1)
   
6.         Arr = .Range("a1:bl" & .[A65536].End(3).Row)
   
7.     End With
   
8.     With ActiveSheet
   
9.         Set ToRange = .Range("F3:J23")
   
10.         ReDim tmpArr(1 To ToRange.Rows.Count, 1 To 5)
    
11.         ReDim n(1 To ToRange.Rows.Count)
    
12.         ToRange.ClearContents: .[G1] = ""
    
13.         xrr = Split(xstr, ",")
    
14.         For i = 6 To UBound(Arr)
    
15.             lotno = Arr(i, 1)
    
16.             part1 = Left(lotno, 13)
    
17.             For Each x In xrr
    
18.                 If lotno = x Then
    
19.                     .Range("G1") = lotno
    
20.                     For j = 5 To 61 Step 3
    
21.                         k = (j - 2) / 3
    
22.                         For jj = 0 To 2
    
23.                              If j + jj <= 61 Then
    
24.                                 If Trim(Arr(i, j + jj)) <> "" Then
    
25.                                     n(k) = n(k) + 1
    
26.                                     If n(k) <= 5 Then tmpArr(k, n(k)) = Arr(i, j + jj)
    
27.                                 End If
    
28.                             End If
    
29.                         Next jj
    
30.                     Next j
    
31.                 End If
    
32.                  part2 = Left(x, 13)
    
33.                 If part1 = part2 Then If InStr(l2, Arr(i, 64)) = 0 Then l2 = l2 & "," & Arr(i, 64)
    
34.             Next
    
35.         Next i
    
36.         ToRange = tmpArr
    
37.         .[l2] = Mid(l2, 2)
    
38.     End With
    
39. End Sub

复制代码