- 帖子
- 32
- 主題
- 7
- 精華
- 0
- 積分
- 89
- 點名
- 0
- 作業系統
- windows
- 軟體版本
- 7.0
- 閱讀權限
- 20
- 註冊時間
- 2016-10-20
- 最後登錄
- 2020-11-25
|
是否可協助修改VBA 程式(跳過M2 & W欄位)
程式執行說明:
當按下Output "Find" 執行案鍵,跳過M2 & W欄位- Private Sub Sel(xstr)
- Dim i, j, jj, k, x, lotno
- Dim ToRange As Range
- Dim tmpArr(), n(), Arr
- With Worksheets(1)
- Arr = .Range("a1:bl" & .[A65536].End(3).Row)
- End With
- With ActiveSheet
- Set ToRange = .Range("F3:J23")
- ReDim tmpArr(1 To ToRange.Rows.Count, 1 To 5)
- ReDim n(1 To ToRange.Rows.Count)
- ToRange.ClearContents: .[G1] = ""
- xrr = Split(xstr, ",")
- For i = 6 To UBound(Arr)
- lotno = Arr(i, 1)
- part1 = Left(lotno, 13)
- For Each x In xrr
- If lotno = x Then
- .Range("G1") = lotno
- For j = 5 To 61 Step 3
- k = (j - 2) / 3
- For jj = 0 To 2
- If j + jj <= 61 Then
- If Trim(Arr(i, j + jj)) <> "" Then
- n(k) = n(k) + 1
- If n(k) <= 5 Then tmpArr(k, n(k)) = Arr(i, j + jj)
- End If
- End If
- Next jj
- Next j
- End If
- part2 = Left(x, 13)
- If part1 = part2 Then If InStr(l2, Arr(i, 64)) = 0 Then l2 = l2 & "," & Arr(i, 64)
- Next
- Next i
- ToRange = tmpArr
- .[l2] = Mid(l2, 2)
- End With
- End Sub
|
-
-
test.zip
(559.4 KB)
|
發表於 2018-7-16 09:45
| 
