如何将选定的列数据从一个工作表加载或复制到另一个工作表

时间:2016-07-23 19:05:08

标签: excel vba excel-vba

我陷入了其中一项要求。我有一个主表(SHeet1),标题有50列,我有另一个表2,其中30列有不同的标题。因此,现在我必须映射两个工作表标题,这意味着工作表1的页眉将转到哪个页面2的页眉和加载/复制30列到另一个Sheet2。 Shee2的少数列标题也将具有默认值,也不需要映射。 以下是我的要求。

Master Sheet1 - >总记录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

SHeet 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 :(得分: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