Board logo

標題: [發問] VBA 程式修改(跳過欄位) [打印本頁]
作者: dea172    時間: 2018-7-16 09:45     標題: VBA 程式修改(跳過欄位)

是否可協助修改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
複製代碼
[attach]28997[/attach]



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)