[發問] VBA 程式修改(跳過欄位)

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2018-7-16 09:45 | 只看該作者

是否可協助修改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)

靜思自在 : 好事要提得起，是非要放得下，成就別人即是成就自己。