標題: 傳回指定的值 [打印本頁]

---

作者: 周大偉    時間: 2011-4-3 21:29     標題: 傳回指定的值

大大們, 好
可否協助小弟把附件內用程式完成, 希望大大們能教導,謝謝!!
[attach]5226[/attach]

---

作者: Hsieh    時間: 2011-4-4 09:11

回復 1# 周大偉

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. If Target(1).Column = 1 Then
   
3.    For Each a In Target
   
4.       r = Application.Match(a, Sheets("Sheet1").[D:D], 0)
   
5.       If IsNumeric(r) Then
   
6.          a.Offset(, 1).Resize(, 2) = Sheets("Sheet1").Cells(r, 5).Resize(, 2).Value
   
7.       End If
   
8.     Next
   
9. End If
   
10. End Sub

複製代碼

---

作者: 周大偉    時間: 2011-4-4 19:36

hsieh,大大,
感謝協助, 工作表可運行, 但小弟現時於工作表中有一個日期函數, 大大可否協助轉為程式, 與先前程式掍入使用, 協助與否, 小弟都已萬分感激, 祝快樂健康, 謝謝!
[attach]5234[/attach]

---

作者: Hsieh    時間: 2011-4-5 10:23

本帖最後由 Hsieh 於 2011-4-5 10:24 編輯

回復 3# 周大偉

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Application.EnableEvents = False
   
3. If Target(1).Column = 1 Then
   
4.    For Each a In Target
   
5.       r = Application.Match(a, Sheets("Sheet1").[D:D], 0)
   
6.       If IsNumeric(r) Then
   
7.          a.Offset(, 1).Resize(, 2) = Sheets("Sheet1").Cells(r, 5).Resize(, 2).Value
   
8.       End If
   
9.     Next
   
10. End If
    
11. If Target(1).Column = 7 Then
    
12.    For Each a In Target
    
13.    If IsDate(a) Then a.Offset(, 1) = DateDiff("yyyy", a, Date)
    
14.    Next
    
15. End If
    
16. Application.EnableEvents = True
    
17. End Sub

複製代碼

---

作者: 周大偉    時間: 2011-4-5 10:36

hsieh大大,
謝謝協助, 祝快樂....

---

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