返回列表 上一主題 發帖

如何從A表欄位名稱去搜尋B表對應的欄位名稱,並將B表的內容貼到A表

peter631114

帖子
18 
主題
6 
精華
0 
積分
24 
點名
0  
作業系統
Windows 
軟體版本
s 
閱讀權限
10 
註冊時間
2018-5-7 
最後登錄
2022-8-9 

論壇榮譽勳章論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2019-12-9 16:15 | 只看該作者

如何從A表欄位名稱去搜尋B表對應的欄位名稱,並將B表的內容貼到A表

Dear版大
我寫了一個Marco程式去抓取另外一個資料(vsDataAnrFunction)的內容,該程式是用已知的欄位(如:A,B,C...欄位)去抓取,但目前發現只要資料(vsDataAnrFunction)的欄位變了,就會導致我拿到錯誤的資料,所以我想請問大大,如何使用欄位名稱去抓取資料(vsDataAnrFunction)的內容.

1206詢問.rar (106.96 KB)
收藏 分享

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-22 
2#
發表於 2019-12-9 17:31 | 只看該作者
Sub MO()
Dim C&, R&, xD, xB As Workbook, Arr, Brr, U&, N&
Set xD = CreateObject("Scripting.Dictionary")
With Sheets("Dump")
    .UsedRange.Offset(1, 0).EntireRow.Delete
    For C = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column
        xD(.Cells(1, C) & "") = C: N = N + 1
    Next
End With
On Error Resume Next
Set xB = Workbooks("vsDataAnrFunction.csv")
On Error GoTo 0
If xB Is Nothing Then Set xB = Workbooks.Open(ThisWorkbook.Path & "\vsDataAnrFunction.csv")
Arr = xB.Sheets(1).UsedRange
ReDim Brr(1 To UBound(Arr), 1 To N)
For C = 1 To UBound(Arr, 2)
    U = xD(Arr(1, C) & ""): If U = 0 Then GoTo 101
For R = 2 To UBound(Arr)
    Brr(R - 1, U) = Arr(R, C)
Next R
101: Next C
xB.Close 0
Sheets("Dump").[A2].Resize(UBound(Arr) - 1, N).Value = Brr
End Sub


'================================

TOP

peter631114

帖子
18 
主題
6 
精華
0 
積分
24 
點名
0  
作業系統
Windows 
軟體版本
s 
閱讀權限
10 
註冊時間
2018-5-7 
最後登錄
2022-8-9 

論壇榮譽勳章論壇贊助勳章
3#
發表於 2019-12-9 22:19 | 只看該作者
Dear 版大
真的非常的感謝~~
我會研讀一下,剛才研讀一下真的有程度,我會google尋找,若有疑問再請版主解釋,(我寫的就像幼稚園班依樣)

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-22 
4#
發表於 2019-12-10 10:05 | 只看該作者
另方:
Sub MO_2()
Dim MyBook As Workbook, MySht As Worksheet, xR As Range, xF As Range
Dim FN$, xB As Workbook, xArea As Range
Application.ScreenUpdating = False
Set MyBook = ThisWorkbook '本檔
FN = "vsDataAnrFunction.csv" 'csv檔案名稱
On Error Resume Next: Set xB = Workbooks(FN): On Error GoTo 0 '檢查csv檔是否已開啟
If xB Is Nothing Then Set xB = Workbooks.Open(MyBook.Path & "\" & FN) '若csv檔未開啟, 開啟之
Set xArea = xB.Sheets(1).UsedRange '設定csv檔資料範圍為range物件
'------------------------------------
Set MySht = MyBook.Sheets("Dump") '本檔資料工作表
MySht.UsedRange.Offset(1, 0).EntireRow.Delete '清除原有資料(保留標題行)
For Each xR In Range(MySht.[A1], MySht.Cells(1, Columns.Count).End(xlToLeft))
    Set xF = xArea.Rows(1).Find(xR, Lookat:=xlWhole) '逐一尋找csv第一行符合標題文字的位置
    If xF Is Nothing Then GoTo 101  '找不到符合時, 略過
    xR.Resize(xArea.Rows.Count).Value = xF.Resize(xArea.Rows.Count).Value '複製整欄資料
101: Next
xB.Close 0
End Sub


'=======================================

TOP

        靜思自在 : 我們要做好社會的環保，也要做好內心的環保。
返回列表 上一主題