帖子: 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

超級版主 Rank: 8 Rank: 8

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

2^#

發表於 2014-3-20 15:33 | 只看該作者

回復 1# j2888237
ThisWorkbook模組

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim A As Range
Set A = Sheets("車子資料").[A:A].Find(Target, , , xlWhole)
Application.EnableEvents = False
If Not A Is Nothing Then Target = A.Offset(, 2)
Application.EnableEvents = True
End Sub

複製代碼

學海無涯_不恥下問

TOP

li_hsien

中學生 Rank: 2

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章論壇贊助勳章 2014馬年全勤獎章 2015羊年全勤獎章熱烈參與勳章

3^#

發表於 2014-3-20 16:01 | 只看該作者

回復 1# j2888237

試看看

每月報表.zip (13.79 KB)

用功到世界末日那一天～～～

TOP

yen956

高中生 Rank: 3 Rank: 3

帖子: 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
試試看:

Option Explicit
'每新增一張 Worksheet, 就將此VBA複製過去
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngD, rngA As Range, sh1 As Worksheet, endRow As Integer
Dim 代碼
Set sh1 = Sheets("車子資料")
endRow = sh1.[A2000].End(xlUp).Row
Set rngA = sh1.[A2].Resize(endRow, 1)
endRow = [D2000].End(xlUp).Row
Set rngD = [D2].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
End Sub

複製代碼

TOP

j2888237

小學生 Rank: 1

帖子: 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

小學生 Rank: 1

帖子: 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

高中生 Rank: 3 Rank: 3

帖子: 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

小學生 Rank: 1

帖子: 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

中學生 Rank: 2

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章論壇贊助勳章 2014馬年全勤獎章 2015羊年全勤獎章熱烈參與勳章

9^#

發表於 2014-3-24 11:22 | 只看該作者

回復 5# j2888237

我是分別放兩個模組裡面

不知這樣O不OK

Option Explicit
Sub test()
Application.OnKey "{ENTER}", "car_info"
End Sub

複製代碼

Option Explicit
Sub car_info()
If Selection.Value <> "" Then
If IsError(Application.VLookup(Selection.Value, Worksheets("車子資料").Range("A:C"), 3, 0)) = False Then
Selection.Value = Application.VLookup(Selection.Value, Worksheets("車子資料").Range("A:C"), 3, 0)
Else
Selection.Value = "無此代碼"
End If
End If
End Sub

複製代碼

參考看看

用功到世界末日那一天～～～

TOP

yen956

高中生 Rank: 3 Rank: 3

帖子: 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