2016-07-23 32 views
-4

我被困在其中一個需求中。我有一個Master Sheets(SHeet1),頭部有50列,我有另外一個Sheet2,有30列,有不同的Header。因此,現在我必須映射兩個表頭,即表單1的頁眉將轉到哪個頁面2的頁眉和加載/複製30列到另一個頁面2。 Shee2的很少的列標題將具有不需要映射的默認值。 以下是我的要求。如何將所選列數據從一張紙加載或複製到另一張紙

Master Sheet1 - > Total Records 100k +。

Object ID system project object_id Revision Iteration ows_BaseName object_name ows_DocumentState ows_Modified_x0020_By ows_Created_x0020_By ows_DocumentOwner ows_Keywords ows_Languages ows_Title ows_Author ows_FileDirRef ows_BaseName 
1 System1 Project 1 Object1 Revision1 Iteration1 ows_BaseName1 object_name1 ows_DocumentState1 ModifiedBy1 CreatedBy1 ows_DocumentOwner1 ows_Keywords1 English ows_Title1 ows_Author1 ows_FileDirRef1 ows_BaseName1 
2 System2 Project 2 Object2 Revision2 Iteration2 ows_BaseName2 object_name2 ows_DocumentState2 ModifiedBy2 CreatedBy2 ows_DocumentOwner2 ows_Keywords2 English ows_Title2 ows_Author2 ows_FileDirRef2 ows_BaseName2 
3 System3 Project 3 Object3 Revision3 Iteration3 ows_BaseName3 object_name3 ows_DocumentState3 ModifiedBy3 CreatedBy3 ows_DocumentOwner3 ows_Keywords3 English ows_Title3 ows_Author3 ows_FileDirRef3 ows_BaseName3 
4 System4 Project 4 Object4 Revision4 Iteration4 ows_BaseName4 object_name4 ows_DocumentState4 ModifiedBy4 CreatedBy4 ows_DocumentOwner4 ows_Keywords4 English ows_Title4 ows_Author4 ows_FileDirRef4 ows_BaseName4 

表2 - >在這個需要被複制 - >

MASTEROBJECTNUMBER MASTERORGANIZATION_NAME MASTERCONTAINERTYPE MASTERCONTAINER MASTERCONTAINER_ORG_NAME MASTERWBMSOURCEIDENTIFIER REVISION DEPARTMENT DESCRIPTION DOCTYPE TITLE FOLDERPATH FORMAT ITERATION ITERATIONNOTE CREATEDBY MODIFIEDBY LIFECYCLE LIFECYCLESTATE CREATEDDATE MODIFIEDDATE TEAM TYPE SOURCEDESCRIPTION WBMSOURCEIDENTIFIER 
1 ABCD LIBRARY System1 ABCD 10 Revision1 ENG ows_Title1 $$Document ows_Title1 /Default/Design_Build_Test Microsoft Excel Iteration1  CreatedBy1 ModifiedBy1 Document LC EFFECTIVE 14-10-2014 14-10-2015  Document Excel Data 100 
2 ABCD LIBRARY System2 ABCD 20 Revision2 ENG ows_Title2 $$Document ows_Title2 /Default/Design_Build_Test Microsoft Excel Iteration2  CreatedBy2 ModifiedBy2 Document LC EFFECTIVE 14-10-2014 14-10-2015  Document Excel Data 101 
3 ABCD LIBRARY System3 ABCD 30 Revision3 ENG ows_Title3 $$Document ows_Title3 /Default/Design_Build_Test Microsoft Excel Iteration3  CreatedBy3 ModifiedBy3 Document LC EFFECTIVE 14-10-2014 14-10-2015  Document Excel Data 102 
+1

等都不是 「代碼爲我」,「教我代碼「或」查找我的代碼「網站。它是一個致力於幫助那些現有代碼克服特定問題的網站。如果您的代碼不起作用,請使用編輯將其發佈在原始文章中,並解釋它在做什麼,這是錯誤的 –

+0

您好斯科特..非常感謝您的回覆和評論。我曾嘗試過使用vlookup函數,但效率並不高。所以想到通過VBA做,但再次讓我嘗試。再次感謝您的回覆和建議。 – user6622113

+0

除了@ScottCraner評論之外,目前還不清楚期望的結果。你有2張需要合併到3'一張嗎?或者您想使用表單1中的值更新表單2?在任何一張表中找到相關記錄的關鍵是什麼? – EBH

回答

0

像這樣的事情

Public Type ColHeaderDest 
    Object As Long 
    ID As Long 
    system As Long 
    project As Long 
    object_id As Long 
    REVISION As Long 
    ITERATION As Long 
    ows_BaseName As Long 
    object_name As Long 
    ows_DocumentState As Long 
    ows_Modified_x0020_By As Long 
    ows_Created_x0020_By As Long 
    ows_DocumentOwner As Long 
    ows_Keywords As Long 
    ows_Languages As Long 
    ows_Title As Long 
    ows_Author As Long 
    ows_FileDirRef As Long 
    ows_BaseName As Long 
End Type 

Public Type ColHeaderSource 
    MASTEROBJECTNUMBER As Long 
    MASTERORGANIZATION_NAME As Long 
    MASTERCONTAINERTYPE As Long 
    MASTERCONTAINER As Long 
    MASTERCONTAINER_ORG_NAME As Long 
    MASTERWBMSOURCEIDENTIFIER As Long 
    REVISION As Long 
    DEPARTMENT As Long 
    DESCRIPTION As Long 
    DOCTYPE As Long 
    TITLE As Long 
    FOLDERPATH As Long 
    FORMAT As Long 
    ITERATION As Long 
    ITERATIONNOTE As Long 
    CREATEDBY As Long 
    MODIFIEDBY As Long 
    LIFECYCLE As Long 
    LIFECYCLESTATE As Long 
    CREATEDDATE As Long 
    MODIFIEDDATE As Long 
    TEAM As Long 
    TYPE As Long 
    SOURCEDESCRIPTION As Long 
    WBMSOURCEIDENTIFIER As Long 
End Type 

Sub test() 

    Dim x As Long 
    Dim y As Long 

    Dim HeaderRowDest As Long 
    Dim HeaderRowSource As Long 
    ' Where is the column description row ? This can be automated but I can't be bothered, sorry 
    HeaderRowDest = 0 
    HeaderRowSource = 0 

    Dim shtSource As Worksheet 
    Dim shtDestination As Worksheet 
    Set shtSource = Worksheets("Sheet1") 
    Set shtDestination = Worksheets("SHeet 2") 

    ' Find last row and next row for source and destination sheets 
    Dim LastRowSource As Long 
    Dim NextRowDest As Long 
    NextRowDest = shtDestination.Range("A" & shtDestination.Rows.Count).End(xlUp).Row + 1 
    LastRowSource = shtSource.Range("A" & shtSource.Rows.Count).End(xlUp).Row + 1 

    Dim myColHeaderDest As ColHeaderDest 
    Dim myColHeaderSource As ColHeaderSource 
    ' Get column header for destination sheet 
    For x = 1 To shtDestination.Cells(HeaderRowDest, shtDestination.Columns.Count).End(xlToLeft).Column 
     Select Case shtDestination.Cells(HeaderRowDest, x).Range.Text 
      Case "Object" 
       myColHeaderDest.Object = x 
      Case "ID" 
       myColHeaderDest.ID = x 
      Case "system" 
       myColHeaderDest.system = x 
      ' ... and so on 
     End Select 
    Next x 

    ' Get column header for source sheet 
    For x = 1 To shtSource.Cells(HeaderRowSource, shtSource.Columns.Count).End(xlToLeft).Column 
     Select Case shtSource.Cells(HeaderRowSource, x).Range.Text 
      Case "MASTEROBJECTNUMBER" 
       myColHeaderSource.MASTEROBJECTNUMBER = x 
      Case "MASTERORGANIZATION_NAME" 
       myColHeaderSource.MASTERORGANIZATION_NAME = x 
      Case "MASTERCONTAINERTYPE" 
       myColHeaderSource.MASTERCONTAINERTYPE = x 
      ' ... and so on 
     End Select 
    Next x 

    ' Loop through all rows in the source sheet, starting at the column description row 
    For x = HeaderRowSource + 1 To LastRowSource 

     NextRowDest = shtDestination.Range("A" & shtDestination.Rows.Count).End(xlUp).Row + 1 

     For y = 1 To shtSource.Cells(HeaderRowSource, shtSource.Columns.Count).End(xlToLeft).Column 
      Select Case y 
       Case myColHeaderSource.MASTEROBJECTNUMBER 
        shtDestination.Cells(myColHeaderDest.Object, NextRowDest).Text = shtSource.Cells(myColHeaderSource.MASTEROBJECTNUMBER, x) 
       Case myColHeaderSource.MASTERORGANIZATION_NAME 
        shtDestination.Cells(myColHeaderDest.ID, NextRowDest).Text = shtSource.Cells(myColHeaderSource.MASTERORGANIZATION_NAME, x) 
       Case myColHeaderSource.MASTERCONTAINERTYPE 
        shtDestination.Cells(myColHeaderDest.system, NextRowDest).Text = shtSource.Cells(myColHeaderSource.MASTERCONTAINERTYPE, x) 

       ' And so on 
      end select 
     Next y 

    Next x 


End Sub 
+0

此代碼將無法正常工作是,顯然,有一個關於從ows_BaseName開始的模糊名字的錯誤,我認爲那裏有非空格的空白字符。你必須解決這個問題。 – Shodan

+0

謝謝@Shodan。我只是通過刪除_來更改爲owsBaseName。但它的編譯錯誤爲「Next for For」。似乎有一些循環錯誤。研究這一點。 – user6622113

+0

是的,有沒有結束選擇。您需要將HeaderRowDest = 0 HeaderRowSource = 0設置爲適當的值。可能其他的事情,這只是爲了讓你開始。 – Shodan

相關問題