- 帖子
- 463
- 主題
- 116
- 精華
- 0
- 積分
- 580
- 點名
- 0
- 作業系統
- Vista
- 軟體版本
- 2007
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2010-5-4
- 最後登錄
- 2017-11-13
 
|
5#
發表於 2011-5-13 22:43
| 只看該作者
回復 4# Hsieh
hsieh前輩你好!
偶像前輩!程式完全正確謝謝!!請前輩再辛苦,
讓程式更進化,問題如附檔說明
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target(1), Range("J3:J1443")) Is Nothing And Target(1) <> "" Then
If [A1] <> "取消" Then ActiveCell.Offset(0, -3).Copy [Y3]
Me.Names.Add "x", ActiveCell.Offset(0, -3)
If [A1] <> "取消" Then Range(Target(1).Offset(1, -9), Target(1).Offset(1, -9).End
(xlDown)).EntireRow.Hidden = True
Target.Offset(, -3) = Target.Value
Range("G:J").EntireColumn.AutoFit
Range("AA1") = 1
Range("AB1") = ActiveCell.Row
End If
If Not Intersect(Target(1), Range("K3:K1443")) Is Nothing And Target(1) <> "" Then
If [A1] <> "取消" Then ActiveCell.Offset(0, -4).Copy [Y3]
Me.Names.Add "x", ActiveCell.Offset(0, -4)
If [A1] <> "取消" Then Range(Target(1).Offset(1, -10), Target(1).Offset(1, -10).End
(xlDown)).EntireRow.Hidden = True
Target.Offset(, -4) = Target.Value
Range("G:J").EntireColumn.AutoFit
Range("AA1") = 1
Range("AB1") = ActiveCell.Row
End If
If Not Intersect(Target(1), Range("L3:L1443")) Is Nothing And Target(1) <> "" Then
If [A1] <> "取消" Then ActiveCell.Offset(0, -5).Copy [Y3]
Me.Names.Add "x", ActiveCell.Offset(0, -5)
If [A1] <> "取消" Then Range(Target(1).Offset(1, -11), Target(1).Offset(1, -11).End
(xlDown)).EntireRow.Hidden = True
Target.Offset(, -5) = Target.Value
Range("G:J").EntireColumn.AutoFit
Range("AA1") = 1
Range("AB1") = ActiveCell.Row
End If
Select Case Target(1).Address(0, 0)
Case "J1"
還原
End Select
End Sub |
|