彰化一整天的論壇

 找回密碼
 立即註冊
查看: 244|回復: 3

請問如何用巨集找相對應位置後貼數據

[複製鏈接]
發表於 2020-6-18 19:31:41 | 顯示全部樓層 |閱讀模式
請教老師,能否用巨集自動找相對應的位置後,再貼數據??   謝謝

例如下圖中

A檔案的B2:B21數據,會跟隨B1作變更

希望能做個巨集,自動從B檔案中,找到相對應A檔案的B1然後把數據貼

( 我只會用巨集貼固定欄位...... )

自動找位置貼數據.jpg

B.xlsm

10.67 KB, 下載次數: 4

A.xlsm

14.07 KB, 下載次數: 4

回復

使用道具 舉報

發表於 2020-6-19 08:53:59 | 顯示全部樓層
本帖最後由 imingho 於 2020-6-19 08:55 編輯

您好,
    程式碼如下.
  1. Sub 巨集1_修改後()
  2. '
  3. ' 巨集1 巨集
  4. '

  5. '
  6.     Dim SNo As String
  7.    
  8.     SNo = Range("b1").Value

  9.     Range("B2:B21").Select
  10.     Selection.Copy
  11.     Windows("B.xlsm").Activate
  12.    
  13.     '找尋相同的捲號
  14.     Cells.Find(What:=SNO, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
  15.     :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
  16.     False, MatchByte:=False, SearchFormat:=False).Activate
  17.    
  18.     ActiveCell.Offset(1, 0).Range("A1").Select
  19.    
  20.     Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
  21.         xlNone, SkipBlanks:=False, Transpose:=False
  22.     Windows("A.xlsm").Activate
  23.     Range("D8").Select
  24. End Sub
複製代碼


A.xlsm

14.07 KB, 下載次數: 0

售價: 1 金錢  [記錄]  [購買]

回復 支持 反對

使用道具 舉報

 樓主| 發表於 2020-6-30 09:16:13 | 顯示全部樓層
imingho 發表於 2020-6-19 08:53
您好,
    程式碼如下.

請問老師,我對應的號碼有-1、-2之類的情形,這樣就會貼錯欄位,會貼到最前面有相類似號碼的第一行
這有辦法修改嗎??  謝謝
貼錯欄位.JPG

B.xlsm

10.58 KB, 下載次數: 1

A.xlsm

16.16 KB, 下載次數: 1

回復 支持 反對

使用道具 舉報

發表於 2020-6-30 16:42:05 | 顯示全部樓層
peacoca 發表於 2020-6-30 09:16
請問老師,我對應的號碼有-1、-2之類的情形,這樣就會貼錯欄位,會貼到最前面有相類似號碼的第一行
這有 ...
  1. Sub 巨集1_修改後()
  2. '
  3. ' 巨集1 巨集
  4. '

  5. '
  6.     Dim SNo As String
  7.    
  8.     SNo = Range("b1").Value

  9.     Range("B2:B21").Select
  10.     Selection.Copy
  11.     Windows("B.xlsm").Activate
  12.    
  13.     '找尋相同的捲號
  14.     Cells.Find(What:=SNo, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
  15.     :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
  16.     False, MatchByte:=False, SearchFormat:=False).Activate
  17.    
  18.     ActiveCell.Offset(1, 0).Range("A1").Select
  19.    
  20.     Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
  21.         xlNone, SkipBlanks:=False, Transpose:=False
  22.     Windows("A.xlsm").Activate
  23.     Range("D8").Select
  24. End Sub
複製代碼

A.xlsm

16.01 KB, 下載次數: 0

售價: 1 金錢  [記錄]  [購買]

回復 支持 反對

使用道具 舉報

您需要登錄後才可以回帖 登錄 | 立即註冊

本版積分規則

Archiver|手機版|小黑屋|彰化一整天的論壇(Excel,Office)  

GMT+8, 2020-7-12 12:32 , Processed in 0.139452 second(s), 22 queries .

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

快速回復 返回頂部 返回列表