- 帖子
- 529
- 主題
- 56
- 精華
- 0
- 積分
- 607
- 點名
- 115
- 作業系統
- win 10
- 軟體版本
- []
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2013-3-19
- 最後登錄
- 2025-5-17
           
|
2#
發表於 2015-8-9 10:37
| 只看該作者
回復 1# starry1314
資料多,試用這個- Option Base 1
- Option Explicit
- Sub 菜色計算()
- Dim i&, j%, k%
- Dim aa '區域、菜色、數量 資料
- Dim bb ''菜色
- Dim cc$ '區分條件
- Dim dd '搜尋結果
-
- Sheets("工作表1").Activate
- aa = Range("A3:C" & [A2].End(xlDown).Row)
- bb = Range("F2:F" & [F2].End(xlDown).Row)
- Range("G2:G" & UBound(bb) + 1).Clear '第2列開始菜色區分
-
- ReDim dd(UBound(bb), 1)
- cc = "TQILP"
-
- For i = 1 To UBound(aa)
- If InStr(cc, Mid(aa(i, 1), 2, 1)) = 0 And aa(i, 3) = 2 Then
- For j = 1 To UBound(bb)
- If aa(i, 2) = bb(j, 1) Then dd(j, 1) = dd(j, 1) + 1: Exit For
- Next
- End If
- Next i
- Cells(2, "G").Resize(UBound(dd)) = dd
-
- End Sub
複製代碼 |
|