返回列表 上一主題 發帖

[發問]如何使用VBA將有重複參照值貼到不同worksheet

s5512765

帖子
1 
主題
1 
精華
0 
積分
2 
點名
0  
作業系統
Win7 
軟體版本
Win7 
閱讀權限
10 
註冊時間
2016-7-27 
最後登錄
2022-7-4 

論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2016-8-2 22:08 | 只看該作者

[發問]如何使用VBA將有重複參照值貼到不同worksheet

各位專家好，我自己近期開始自己鑽研程式撰寫,
由於是VBA新手，近來配合工作所需想要寫一個VBA程式，查了網路上許多資料，必須跨不同表單參照的一個作業
本想使用巨集搭配Vlookup函數但因為他並不是Case sensitive的函數，因此作罷

嘗試寫了Index 參照表但發現比對會停不下來，我想跟我下的指令有關
預期希望按下按鈕(透過"帶入職能(right)"的按鈕,TriggerH2欄位讓表A底下的能從表B欄位A以及其相同列資料都能匯入相對應的值
如圖:


但拼湊的巨集都會變成這樣...


這是我的程式碼
  1. Sub 按鈕9_Click()

  3. Dim SourceLastRow As Long
  4. Dim OutputLastRow As Long
  5. Dim sourceSheet As Worksheet
  6. Dim outputSheet As Worksheet




  11. 'What are the names of our worksheets?
  12. Set sourceSheet = Worksheets("competencylist_2016")
  13. Set outputSheet = Worksheets("inserttext")

  15. 'Determine last row of source
  16. With sourceSheet
  17.     SourceLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
  18. End With
  19. With outputSheet
  20.     'Determine last row in col P
  21.    OutputLastRow = .Cells(.Rows.Count, "P").End(xlUp).Row
  22.     'Apply our formula
  23.    
  24.   

  26.    .Range("B6:B20" & OutputLastRow).Formula = _
  27.         "=INDEX('competencylist_2016'!$C$2:$C$100, SMALL(INDEX(($H$2='competencylist_2016'!$A$2:$A$100)*(MATCH(ROW('competencylist_2016'!$A$2:$A$100),ROW('competencylist_2016'!$A$2:$A$100)))+($H$2<>'competencylist_2016'!$A$2:$A$100)*1048577,0,0),ROW('competencylist_2016'!A1)))"

  29.    .Range("C6:C20" & OutputLastRow).Formula = _
  30.        "=VLOOKUP(B:B,'" & sourceSheet.Name & "'!$C$1:$F$1" & SourceLastRow & ",2,0)"
  31. End With

  33. End Sub
複製代碼
望各位先進給予指導，謝謝!
VBA TEST08022016.rar (375.92 KB)
收藏 分享

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2016-8-12 07:22 | 只看該作者
回復 1# s5512765
  1. Range("B6:B20" & OutputLastRow).Formula
  2.    .Range("C6:C20" & OutputLastRow).Formula =
複製代碼
工作表上設的公式 當職務編號 的BBItem3,BItem4 小於 20-6 ,所套的公式, 當然有錯誤值

試試看
  1. Option Explicit
  2. Sub 按鈕9_Click()
  3.     Dim sourceSheet As Worksheet         '**  變數型態為工作表物件
  4.     Dim outputSheet As Worksheet         '**  變數型態為工作表物件
  5.     'What are the names of our worksheets?
  6.     Set sourceSheet = Worksheets("competencylist_2016")
  7.     Set outputSheet = Worksheets("inserttext")
  8.      outputSheet.Range("B6:I" & Rows.Count) = "" '**清除舊有的資料
  9.    
  10.     With sourceSheet
  11.              '**Count 屬性 傳回一個 Long (長整數)，等於在一個集合物件中的物件數目。唯讀。
  12.              '** Columns.Count  -> 工作表的所有欄數
  13.             
  14.              .Cells(1, Columns.Count - 3).Resize(, 4) = Array(.Range("A1"), "", .Range("C1"), .Range("D1"))
  15.               '** 寫入字串  BBItem1 ,"", BBItem3, BBItem4
  16.             
  17.              .Cells(2, Columns.Count - 3) = outputSheet.Range("H2")  '**職務編號
  18.             
  19.              '**進階篩選
  20.              .Range("A1").CurrentRegion.AdvancedFilter xlFilterCopy, .Cells(1, Columns.Count - 3).Resize(2), .Cells(1, Columns.Count - 1).Resize(1, 2)
  21.             
  22.             '.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Cells(1, Columns.Count - 3).Resize(2), CopyToRange:=.Cells(1, Columns.Count - 1).Resize(1, 2)
  23.              '** AdvancedFilter 範圍的進階篩選 , xlFilterCopy  篩選到其他位置
  24.              '**AdvancedFilter 方法   基於準則範圍從資料清單中篩選或複製資料。如果初始選定為單個儲存格，則使用儲存格目前的區域x為Variant。
  25.              '**  expression.AdvancedFilter(Action, CriteriaRange, CopyToRange, Unique)
  26.              '**expression      必選。該運算式會傳回 [套用於] 清單中的其中一個物件。
  27.               '**  Action     必選的 XlFilterAction 資料類型。
  28.             '** XlFilterAction 可以是這些 XlFilterAction 常數之一。 xlFilterCopyxlFilterInPlace
  29.             '**CriteriaRange     選擇性的 Variant。準則範圍。如果省略此引數則無準則。
  30.             '**CopyToRange     選擇性的 Variant。如果 Action 為 xlFilterCopy，此引數指定被複製列的目標範圍。否則忽略此引數。
  31.             '**Unique     選擇性的 Variant。若為 True，則僅篩選唯一的記錄；若為 False，則篩選出所有符合準則的記錄。預設值為 False。
  32.             
  33.             With .Cells(1, Columns.Count - 1).Resize(1, 2).CurrentRegion
  34.                 If .Rows.Count > 1 Then
  35.                     outputSheet.Range("B6").Resize(.Rows.Count - 1, 2) = .Rows("2:" & .Rows.Count).Value
  36.                     With outputSheet.Range("H6").Resize(.Rows.Count - 1, 2)
  37.                         .Columns(1) = "=RC[-2]-RC[-3]"         '公式 : 用 R1C1相對位置
  38.                         .Columns(2) = "=RC[-2]-RC[-4]"
  39.                     End With
  40.                 End If
  41.                 End With
  42.             .Cells(1, Columns.Count - 3).Resize(, 4).EntireColumn = ""  '範圍: 清除字串
  43.     End With
  44. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 人生不一定球球是好球，但是有歷練的強打者，隨時都可以揮棒。
返回列表 上一主題