傳回指定的值

周大偉

大大們, 好
可否協助小弟把附件內用程式完成, 希望大大們能教導,謝謝!!
cc.rar (19.34 KB)

下載次數: 11

2011-4-3 21:29

Hsieh

回復 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

複製代碼

周大偉

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

下載次數: 13

2011-4-4 19:35

Hsieh

回復 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

複製代碼

周大偉

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