返回列表 上一主題 發帖

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

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

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

描述

Snap2.jpg
2019-12-9 16:13
1206詢問.rar (106.96 KB)

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

Dear 版大
真的非常的感謝~~
我會研讀一下,剛才研讀一下真的有程度,我會google尋找,若有疑問再請版主解釋,(我寫的就像幼稚園班依樣)

TOP

另方:
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

        靜思自在 : 閒人無樂趣,忙人無是非。
返回列表 上一主題