Board logo

標題: [發問] 如何在同一個儲存格打上代碼跑出對應的資料 [打印本頁]
作者: j2888237    時間: 2014-3-20 11:03     標題: 如何在同一個儲存格打上代碼跑出對應的資料

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

請參考附件說明[attach]17829[/attach]

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

[attach]17828[/attach]
作者: Hsieh    時間: 2014-3-20 15:33

回復 1# j2888237
ThisWorkbook模組
  1. Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  2. Dim A As Range
  3. Set A = Sheets("車子資料").[A:A].Find(Target, , , xlWhole)
  4. Application.EnableEvents = False
  5. If Not A Is Nothing Then Target = A.Offset(, 2)
  6. Application.EnableEvents = True
  7. End Sub
複製代碼
作者: li_hsien    時間: 2014-3-20 16:01

回復 1# j2888237

試看看

[attach]17831[/attach]
作者: yen956    時間: 2014-3-20 20:09

回復 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
複製代碼
作者: j2888237    時間: 2014-3-21 18:04

回復 3# li_hsien


    權限不夠，無法下載檔案!!:'(
作者: j2888237    時間: 2014-3-21 18:11

回復 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
    修改一段，但會有問題!!!  :'(
作者: yen956    時間: 2014-3-22 04:37

本帖最後由 yen956 於 2014-3-22 04:44 編輯

回復 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    時間: 2014-3-24 09:54

回復 7# yen956


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

再請大大要如何解決這個問題?
謝謝yen956大大百忙之中回覆… ^^
作者: li_hsien    時間: 2014-3-24 11:22

回復 5# j2888237

我是分別放兩個模組裡面

不知這樣O不OK
  1. Option Explicit

  3. Sub test()

  5.     Application.OnKey "{ENTER}", "car_info"

  7. End Sub
複製代碼
  1. Option Explicit

  3. Sub car_info()

  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
複製代碼
參考看看
作者: yen956    時間: 2014-3-24 11:52

回復 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)
才有關.
作者: j2888237    時間: 2014-3-25 08:52

回復 10# yen956


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



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