如何從A表欄位名稱去搜尋B表對應的欄位名稱,並將B表的內容貼到A表
- 帖子
- 18
- 主題
- 6
- 精華
- 0
- 積分
- 24
- 點名
- 0
- 作業系統
- Windows
- 軟體版本
- s
- 閱讀權限
- 10
- 註冊時間
- 2018-5-7
- 最後登錄
- 2022-8-9
 
|
如何從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-25
|
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
'================================ |
|
|
|
|
|
|
|
- 帖子
- 18
- 主題
- 6
- 精華
- 0
- 積分
- 24
- 點名
- 0
- 作業系統
- Windows
- 軟體版本
- s
- 閱讀權限
- 10
- 註冊時間
- 2018-5-7
- 最後登錄
- 2022-8-9
|
3#
發表於 2019-12-9 22:19
| 只看該作者
Dear 版大
真的非常的感謝~~
我會研讀一下,剛才研讀一下真的有程度,我會google尋找,若有疑問再請版主解釋,(我寫的就像幼稚園班依樣) |
|
|
|
|
|
|
|
- 帖子
- 2834
- 主題
- 10
- 精華
- 0
- 積分
- 2890
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-11-25
|
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
'======================================= |
|
|
|
|
|
|
|
