2016-07-23 31 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

相关问题