返回列表 上一主題 發帖

[發問] 輸入至不同欄位儲存格來個別找出兩個工作表對應值

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
1# 跳轉到 »
發表於 2012-9-22 09:36 | 顯示全部帖子
各位大大

1.Sheet2表和Sheet3表為資料列各有數千筆資料.
2.Sheet1表A:C欄為Sheet2輸出區,而D:G欄為Shee ...
luke 發表於 2012-9-20 20:19

Module1
  1. Public v2, v3
複製代碼
ThisWorkBook
  1. Private Sub Workbook_Open()
  2.   Dim rTar As Range
  3.   
  4.   Set v2 = CreateObject("Scripting.Dictionary")
  5.   Set v3 = CreateObject("Scripting.Dictionary")
  6.   
  7.   With Sheets("sheet2")
  8.     For Each rTar In .Range(.[A2], .[A2].End(xlDown))
  9.       v2(rTar & "") = rTar.Row
  10.     Next rTar
  11.   End With
  12.   
  13.   With Sheets("sheet3")
  14.     For Each rTar In .Range(.[A2], .[A2].End(xlDown))
  15.       v3(rTar & "") = rTar.Row
  16.     Next rTar
  17.   End With
  18. End Sub
複製代碼
Sheet1
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.   Dim iI%
  3.   Dim rTar As Range
  4.   
  5.   Set rTar = Target
  6.   With rTar
  7.     Select Case .Column
  8.    
  9.       Case 1 ' 區分
  10.         With .Parent
  11.           For iI = 2 To 3
  12.             .Cells(rTar.Row, iI) = Sheets("sheet2").Cells(v2(rTar.Text), iI)
  13.           Next iI
  14.         End With
  15.    
  16.       Case 4 ' 票號
  17.         With .Parent
  18.           For iI = 2 To 4
  19.             .Cells(rTar.Row, iI + 3) = Sheets("sheet3").Cells(v3(rTar.Text), iI)
  20.           Next iI
  21.         End With
  22.    
  23.     End Select
  24.   End With
  25. End Sub
複製代碼
TEST25-ans.zip (38.42 KB)
檔案中 Sheet1 右下資料是保留來驗證用的.

TOP

        靜思自在 : 要用心，不要操心、煩心。
返回列表 上一主題