- 帖子
- 47
- 主題
- 6
- 精華
- 0
- 積分
- 74
- 點名
- 0
- 作業系統
- Windows XP
- 軟體版本
- Office 2003
- 閱讀權限
- 20
- 性別
- 男
- 來自
- Macau
- 註冊時間
- 2011-6-15
- 最後登錄
- 2016-7-4
|
本帖最後由 StanleyVic 於 2011-8-1 11:34 編輯
回復 4# GBKEE
謝謝你的熱心幫助.本人新手.代碼寫得有點亂,讓你見笑..
是這樣的,本身己經在sheet2中執下這個動作. 代碼各方面我己經寫好,就是差那一段給搞亂了好久,最後我用錄,當時在MArco下.ok~可以.但放進去就不行.於是我發貼.才知.我欠了 With工作表 . (不過怎也好. 也要再次向謝謝~)
Private Sub NegativeRecord_Click()
'續張型號工作表作運算----------------------------------------------------------
Dim WsName, N, i, j, K As Integer '不同工作表
Dim X, Y, Z As Integer '自身工作表的範圍
Dim Sh As Worksheet 'Dim(宣告變數為私用變數) 型態為 Worksheet(工作表)
'移除所有Sh(工作表)的Hyperlinks(超連結集合物件)刪除----------------------------
For Each Sh In Sheets
Sh.Hyperlinks.Delete
Next
'先Delete所有舊Record!---------------------------------------------------------
X = 4: Y = Range("A65536").End(xlUp).Row
Range("A4:D" & Y).Hyperlinks.Delete
Range("A4:D" & Y).ClearContents
'設定所有型號Sheet中,以最Updata的方法計算因 Out 而引致的 負數Total 記錄------------
N = Worksheets.Count
For WsName = 3 To N
Sheets(WsName).Activate
i = Sheets(WsName).Range("IV3").End(xlToLeft).Column
For j = 2 To i
If Sheets(WsName).Cells(3, j).Value = "Out" Then
For K = 4 To Sheets(WsName).Range("A65536").End(xlUp).Row
If Sheets(WsName).Cells(K, j).Value <> "" And Sheets(WsName).Cells(K, j + 1) < 0 Then
'抄 data進去, 讀出對應路徑 及 超連結 ---------------
Cells(X, "A").Value = Sheets(WsName).Cells(K, 1)
Cells(X, "B").Value = Sheets(WsName).Cells(1, j - 2)
Cells(X, "C").Value = Sheets(WsName).Cells(K, j + 1)
Cells(X, "D").Value = Sheets(WsName).Name & "!" & Sheets(WsName).Cells(K, j + 1). _
Address(RowAbsolute:=False, ColumnAbsolute:=False)
With Sheets(2)
.Hyperlinks.Add Anchor:=.Cells(X, "D"), _
Address:="", _
SubAddress:=.Cells(X, "D").Value, _
TextToDisplay:=.Cells(X, "D").Value
End With
X = X + 1
End If
Next K
End If
Next j
Next WsName
Sheets(2).Activate
'只保留最UPdate資料--------------------------------------------
For Z = Range("A65536").End(xlUp).Row To 4 Step -1
If Cells(Z, "B").Value = Cells(Z - 1, "B").Value Then
Rows(Z - 1).Delete
End If
Next Z
MsgBox ("負數資料己經全部顯示 !")
End Sub |
-
-
20002.JPG
(134.98 KB)
|
發表於 2011-7-30 11:02
| 
