12
返回列表 上一主題 發帖

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

j2888237

帖子
10 
主題
3 
精華
0 
積分
13 
點名
0  
作業系統
XP 
軟體版本
OFFICE2003 
閱讀權限
10 
性別
女 
註冊時間
2010-8-26 
最後登錄
2014-3-25 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2014-3-20 11:03 | 只看該作者

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

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

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

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

收藏 分享

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
152  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-7-3 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 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
複製代碼
學海無涯_不恥下問

TOP

li_hsien

帖子
248 
主題
55 
精華
0 
積分
314 
點名
129  
作業系統
XP / WIN7 
軟體版本
2003 / 2007 
閱讀權限
20 
性別
男 
來自
Tainan 
註冊時間
2013-10-18 
最後登錄
2024-7-3 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇贊助勳章2014馬年全勤獎章2015羊年全勤獎章熱烈參與勳章
3#
發表於 2014-3-20 16:01 | 只看該作者
回復 1# j2888237

試看看

每月報表.zip (13.79 KB)
用功到世界末日那一天∼∼∼

TOP

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
4#
發表於 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
複製代碼

TOP

j2888237

帖子
10 
主題
3 
精華
0 
積分
13 
點名
0  
作業系統
XP 
軟體版本
OFFICE2003 
閱讀權限
10 
性別
女 
註冊時間
2010-8-26 
最後登錄
2014-3-25 
5#
發表於 2014-3-21 18:04 | 只看該作者
回復 3# li_hsien


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

TOP

j2888237

帖子
10 
主題
3 
精華
0 
積分
13 
點名
0  
作業系統
XP 
軟體版本
OFFICE2003 
閱讀權限
10 
性別
女 
註冊時間
2010-8-26 
最後登錄
2014-3-25 
6#
發表於 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
    修改一段，但會有問題!!!  :'(

TOP

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
7#
發表於 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

TOP

j2888237

帖子
10 
主題
3 
精華
0 
積分
13 
點名
0  
作業系統
XP 
軟體版本
OFFICE2003 
閱讀權限
10 
性別
女 
註冊時間
2010-8-26 
最後登錄
2014-3-25 
8#
發表於 2014-3-24 09:54 | 只看該作者
回復 7# yen956


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

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

TOP

li_hsien

帖子
248 
主題
55 
精華
0 
積分
314 
點名
129  
作業系統
XP / WIN7 
軟體版本
2003 / 2007 
閱讀權限
20 
性別
男 
來自
Tainan 
註冊時間
2013-10-18 
最後登錄
2024-7-3 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇贊助勳章2014馬年全勤獎章2015羊年全勤獎章熱烈參與勳章
9#
發表於 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
複製代碼
參考看看
用功到世界末日那一天∼∼∼

TOP

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
10#
發表於 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)
才有關.

TOP

        靜思自在 : 口說一句好話，如口出蓮花；口說一句壞話如口吐毒蛇。
12
返回列表 上一主題