[發問] 如何在同一個儲存格打上代碼跑出對應的資料

j2888237

各位大大，大家好：
在附件裡面，有「車子資料」的Sheet與「3月」的Sheet。
1.想要在「3月」的儲存格打上車子代碼，在同一個儲存格會出現「車子資料」所設定好的" 車型 "。
2.每一個月都會新增一張sheet，操作法式如同No.1。

請參考附件說明 每月報表.zip (3 KB)

下載次數: 13

2014-3-20 11:02

因為我對程式語法不熟，不知道程式應該怎麼寫?想救高手們幫忙，非常謝謝大家的幫忙!

下載 (95.91 KB)
範例說明

2014-3-20 10:52

j2888237

回復 10# yen956


    感謝yen956大大詳細解說，這當中我也學到一點東西，另外也完成主管交辦的報表，真的謝謝您~ ^^

yen956

回復 8# j2888237
大大你好:
請將
    '由[D2000]開始向上查, 直到找到非空白格為止
    endRow = [D2000].End(xlUp).Row
改成(因司機在 欄C)
    '由[C2000]開始向上查, 直到找到非空白格為止
    endRow = [C2000].End(xlUp).Row
也可改成 endRow = 2000, 固定 rngD 的範圍,
但範圍愈大. Excel 的執行效率愈差.
又上次沒說清, rngD 只是個變數(命名為 Rng, myRng, XY 均可),
與 欄D 無關, 與
    Set rngD = [D2].Resize(endRow, 31)
才有關.

li_hsien

回復 5# j2888237

我是分別放兩個模組裡面

不知這樣O不OK

1. Option Explicit
   
2. 
   
3. Sub test()
   
4. 
   
5.     Application.OnKey "{ENTER}", "car_info"
   
6. 
   
7. End Sub

複製代碼

1. Option Explicit
   
2. 
   
3. Sub car_info()
   
4. 
   
5.     If Selection.Value <> "" Then
   
6.         
   
7.         If IsError(Application.VLookup(Selection.Value, Worksheets("車子資料").Range("A:C"), 3, 0)) = False Then
   
8.             Selection.Value = Application.VLookup(Selection.Value, Worksheets("車子資料").Range("A:C"), 3, 0)
   
9.         Else
   
10.             Selection.Value = "無此代碼"
    
11.         End If
    
12.     End If
    
13.    
    
14. End Sub

複製代碼

參考看看

j2888237

回復 7# yen956


    非常感謝yen956大大熱心回覆 :
    經大大的指導後，2日、3日…31日都可以正常顯示車號所對應的大小，
   可是這裡有個小問題就是:如果司機有15位，在這份excel表中倒數4位司機在該月份的1日並無開車，這樣會讓2日之後倒數3位司機所輸入的代碼帶不出對應的資料來，除非至少在1日倒數第2位司機要有「大小」資料，否則2日開始之後這份excel表倒數那幾位司機，都帶不出資料。

再請大大要如何解決這個問題?
謝謝yen956大大百忙之中回覆… ^^

yen956

回復 6# j2888237
抱歉, 沒注意到日期往橫的,
請將
Set rngD = [D2].Resize(endRow, 1)
改成
Set rngD = [D2].Resize(endRow, 31)
就可以了, 抱歉!!

如果日期改成從[E2]開始, 則
Set rngD = [E2].Resize(endRow, 31)
就可以了

若改
Set rngE = [E2].Resize(endRow, 31)
則這裡也要改
If Not Intersect(Target, rngE) Is Nothing Then

j2888237

回復 4# yen956


    請教yen956 大大 :
    1日的欄位能正常跑出來，但是2日開始就不行了，
   我試過再新增rngE, 覆製
   Set rngE = [E2].Resize(endRow, 1)
    If Not Intersect(Target, rngD) Is Nothing Then
    代碼 = Application.Match(Target, rngA, 0)
     On Error Resume Next
    Target = sh1.[A1].Offset(代碼, 2)
     End If
    修改一段，但會有問題!!!  :'(

j2888237

回復 3# li_hsien


    權限不夠，無法下載檔案!!:'(

yen956

回復 1# j2888237
試試看:

1. Option Explicit
   
2. '每新增一張 Worksheet, 就將此VBA複製過去
   
3. Private Sub Worksheet_Change(ByVal Target As Range)
   
4.     Dim rngD, rngA As Range, sh1 As Worksheet, endRow As Integer
   
5.     Dim 代碼
   
6.     Set sh1 = Sheets("車子資料")
   
7.    
   
8.     endRow = sh1.[A2000].End(xlUp).Row
   
9.     Set rngA = sh1.[A2].Resize(endRow, 1)
   
10.    
    
11.     endRow = [D2000].End(xlUp).Row
    
12.     Set rngD = [D2].Resize(endRow, 1)
    
13.    
    
14.     If Not Intersect(Target, rngD) Is Nothing Then
    
15.         代碼 = Application.Match(Target, rngA, 0)
    
16.         On Error Resume Next
    
17.         Target = sh1.[A1].Offset(代碼, 2)
    
18.     End If
    
19. End Sub

複製代碼

li_hsien

回復 1# j2888237

試看看

每月報表.zip (13.79 KB)

下載次數: 9

2014-3-20 16:01