ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] VBA µ{¦¡­×§ï(¸õ¹LÄæ¦ì)

[µo°Ý] VBA µ{¦¡­×§ï(¸õ¹LÄæ¦ì)

¬O§_¥i¨ó§U­×§ïVBA µ{¦¡(¸õ¹LM2 & WÄæ¦ì)
µ{¦¡°õ¦æ»¡©ú:
·í«ö¤UOutput "Find" °õ¦æ®×Áä,¸õ¹LM2 & 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
½Æ»s¥N½X

test.zip (559.4 KB)

        ÀR«ä¦Û¦b : ¤H¥Í¨S¦³©Ò¦³Åv¡A¥u¦³¥Í©Rªº¨Ï¥ÎÅv¡C
ªð¦^¦Cªí ¤W¤@¥DÃD