- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 273
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2024-12-17
              
|
10#
發表於 2012-12-6 17:49
| 只看該作者
回復 9# 198188
應該是你的作用中工作表並非Sheet1
那就公式內參照加上工作表- Sub ex()
- Set d = CreateObject("Scripting.Dictionary")
- ay = Array("OBL", "OHC", "CO")
- With Sheets("Sheet1")
- Set Rng = .Range(.[C2], .Cells(.Rows.Count, 3).End(xlUp))
- For Each a In Rng
- If IsEmpty(d(a.Value)) Then
- For i = 9 To 11
- Set rng1 = .Cells(2, i).Resize(Rng.Rows.Count, 1)
- Set rng2 = .Cells(2, i + 6).Resize(Rng.Rows.Count, 1)
- x = Evaluate("SumProduct((" & Rng.Address(, , , 1) & "=" & a & ")*(" & rng1.Address(, , , 1) & "<>""""))") '參照位址包含外部參照
- y = Evaluate("SumProduct((" & Rng.Address(, , , 1) & "=" & a & ")*(" & rng2.Address(, , , 1) & "<>""""))") '參照位址包含外部參照
- If x = 0 Xor y = 0 Then mystr = IIf(mystr = "", ay(i - 9), mystr & "," & ay(i - 9))
- Next
- If mystr <> "" Then d(a.Value) = Array(a.Value, a.Offset(, 1).Value, a.Offset(, 2).Value, a.Offset(, 3).Value, mystr) Else d.Remove a.Value
- mystr = ""
- End If
- Next
- End With
- With Sheets("ON HAND")
- .UsedRange.Offset(1).ClearContents
- If d.Count > 0 Then .[A2].Resize(d.Count, 5) = Application.Transpose(Application.Transpose(d.items))
- End With
- End Sub
|
|
發表於 2012-12-6 00:13
| 
