- 帖子
- 2035
- 主題
- 24
- 精華
- 0
- 積分
- 2031
- 點名
- 0
- 作業系統
- Win7
- 軟體版本
- Office2010
- 閱讀權限
- 100
- 性別
- 男
- 註冊時間
- 2012-3-22
- 最後登錄
- 2024-2-1
|
回復 118# starbox520
試試看！- Private Sub CommandButton2_Click()
- Dim Arr As Variant, Brr As Variant, aa As Variant, i&, j&, x$, Myr&
- Dim d As Object, t As Variant
- Set d = CreateObject("Scripting.Dictionary")
-
-
- ' 比對 "TR排機&產出" 灰色欄位 "E" (Customer)、 "F" (Package)、 "G" (Bodysize)、 "H" (L/C) 比對
- ' "量大未排機" 找到一樣的， 秀上 "TR排機&產出" 的 "B" 欄 (機台編號) 同一列的 "機台編號"。
- With Sheets("TR排機&產出")
- Arr = .[A1].CurrentRegion.Value
-
- For i = 4 To (UBound(Arr) - 3) Step 5
- If Not IsError(Arr(i, 5)) Then '& "|" & Arr(i, 6) & "|" & Arr(i, 7) & "|" & Arr(i, 8)
- x = Arr(i, 5) & "|" & Arr(i, 6) & "|" & Arr(i, 7) & "|" & Arr(i, 8)
- d(x) = IIf(IsEmpty(d(x)), CStr(i), d(x) & "," & CStr(i))
- End If
- Next
- End With
- With Sheets("量大未排機")
- Brr = .[A1].CurrentRegion
-
- For i = 2 To UBound(Brr)
- x = Brr(i, 1) & "|" & Brr(i, 2) & "|" & Brr(i, 3) & "|" & Brr(i, 4)
-
- If d.exists(x) Then
- t = d(x)
-
- If InStr(t, ",") Then
- aa = Split(t, ",")
-
- For j = 0 To UBound(aa)
- .Cells(i, 9 + j) = Arr(aa(j), 2)
- Next
- Else
- .Cells(i, 9) = Arr(t, 2)
- End If
- End If
- Next
-
- ' 主要想設置 "H" (數量) 欄 數量由大至小，這邊以錄製巨集使用
- .AutoFilter.Sort.SortFields.Clear
- .AutoFilter.Sort.SortFields.Add Key:=Range( _
- "H1:H500"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
- xlSortNormal
-
- With .AutoFilter.Sort
- .Header = xlYes
- .MatchCase = False
- .Orientation = xlTopToBottom
- .SortMethod = xlPinYin
- .Apply
- End With
- End With
- End Sub
|
|
發表於 2016-12-24 18:21
| 
