標題: 回到原來的位置 [打印本頁]

---

作者: myleoyes    時間: 2011-5-11 22:58     標題: 回到原來的位置

各位前輩你們好!
         前輩!!問題如附檔說明
         請知道的前輩,不吝賜教謝謝再三!!

---

作者: oobird    時間: 2011-5-12 10:22

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
       If Not Intersect(Target(1), Range("J3:J1443")) Is Nothing And Target(1) <> "" And [A1] <> "取消" Then
          ActiveCell.Offset(0, -3).Copy [Y3]
       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
     ElseIf Target.Address = "$J$1" Then
          還原
    End If
End Sub
這樣嗎？

---

作者: myleoyes    時間: 2011-5-12 21:01

回復 2# oobird
oobird前輩你好!
      前輩!謝謝!小弟解釋不清楚
      小弟要的是還原這個程式
      Sub 還原() 'J1
          [G13] = [Y3]
          Range("Y3,AA1") = ""
          Rows("3:1443").EntireRow.Hidden = False
      End Sub
      範例Y3的值是點選J13的結果
      按J1時還原程式將Y3的值還原回去G13的位置
      如果點選J66
      按J1時還原程式也是將Y3的值還原回去G66的位置
      以此類推請再辛苦囉!謝謝再三!!

---

作者: Hsieh    時間: 2011-5-12 23:32

回復 3# myleoyes
試試看

    Sheet1模組

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.        If Not Intersect(Target(1), Range("J3:J1443")) Is Nothing And Target(1) <> "" And [A1] <> "取消" Then
   
3.           ActiveCell.Offset(0, -3).Copy [Y3]
   
4.           Me.Names.Add "x", ActiveCell.Offset(0, -3)
   
5.        Range(Target(1).Offset(1, -9), Target(1).Offset(1, -9).End(xlDown)).EntireRow.Hidden = True
   
6.        Target.Offset(, -3) = Target.Value
   
7.        Range("G:J").EntireColumn.AutoFit
   
8.        Range("AA1") = 1
   
9.      End If
   
10.      Select Case Target(1).Address(0, 0)
    
11.         Case "J1"
    
12.           還原
    
13.     End Select
    
14. End Sub

複製代碼

一般模組

1. Sub 還原() 'J1
   
2.    Sheet1.[x] = [Y3]
   
3.     Range("Y3,AA1") = ""
   
4.     Rows("3:1443").EntireRow.Hidden = False
   
5. End Sub

複製代碼

---

作者: myleoyes    時間: 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

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)