- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 108
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2024-5-10
              
|
6#
發表於 2012-11-13 15:48
| 只看該作者
回復 1# mycmyc
你要的結果是這樣吧
執行以下代碼- Sub ex()
- Dim Rng As Range, MyRng As Range, A As Range
- With 工作表1
- Set MyRng = .[C1]
- .Range("C:C").Replace 2120, "=1/0", xlWhole
- Set Rng = .Range("C:C").SpecialCells(xlCellTypeFormulas, 16)
- Rng.Value = 2120
- For Each ar In Rng.Areas
- For Each A In ar
- If A.Offset(, 2) = "五金" And A.Offset(, 4) > 500 Then
- ad = .Range(.[A1], A.Offset(, -2)).Address
- k = Evaluate("Lookup(2,1/(" & ad & "),row(" & ad & "))")
- Set MyRng = Union(MyRng, .Range(.Cells(k, 3), A.End(xlDown)))
- Exit For
- End If
- Next
- Next
- If Not MyRng Is Nothing Then MyRng.EntireRow.Copy 工作表2.[A1]
- End With
- End Sub
|
|
發表於 2012-11-8 22:15
| 
