Копирование целых столбцов (на основе определенных заголовков) с одного листа на другой (в другом порядке) не работает в Excel 365 - PullRequest
0 голосов
/ 26 июня 2019

есть проблема, которую я не могу преодолеть в одиночку:

Ниже код отлично работает на моем Win 8.1 под управлением Excel 2013 Pro (32-разрядная версия).Это с треском проваливается на Win 10 с Excel 365 (также 32-битным).

Консоль VBA выделяет имена, которые я назначаю столбцам (SRO, Desc, Status, Project и т. Д.) Синим цветом и«Private Sub Generate ()» в желтом.

Private Sub Generate()

    Application.EnableEvents = False
    Application.ScreenUpdating = False

        ActiveWorkbook.Sheets("Imported Data").Activate

'tis where You select what columns You want to copy and name them

            SRO = WorksheetFunction.Match("SroNum", Rows("1:1"), 0)
            Desc = WorksheetFunction.Match("Description", Rows("1:1"), 0)
            Status = WorksheetFunction.Match("Status", Rows("1:1"), 0)
            Project = WorksheetFunction.Match("srouf_platform", Rows("1:1"), 0)
            SROlead = WorksheetFunction.Match("Name", Rows("1:1"), 0)
            OpenDate = WorksheetFunction.Match("CreateDate", Rows("1:1"), 0)
            CloseDate = WorksheetFunction.Match("Close Date", Rows("1:1"), 0)
            TPT = WorksheetFunction.Match("SroTPTinDays", Rows("1:1"), 0)
            STATUSnew = WorksheetFunction.Match("srouf_intel_sro_status", Rows("1:1"), 0)
            WRKstat = WorksheetFunction.Match("Status Code", Rows("1:1"), 0)
            OpCode = WorksheetFunction.Match("OperationCode", Rows("1:1"), 0)
            Priority = WorksheetFunction.Match("Priority Code", Rows("1:1"), 0)
            OpPartner = WorksheetFunction.Match("OperationPartnerName", Rows("1:1"), 0)
            DUT = WorksheetFunction.Match("LineSerialNum", Rows("1:1"), 0)
            OpDesc = WorksheetFunction.Match("OperationDescription", Rows("1:1"), 0)
            OpStatus = WorksheetFunction.Match("OperationStatus", Rows("1:1"), 0)
            CreatedBy = WorksheetFunction.Match("CreatedBy", Rows("1:1"), 0)


'adding new sheet - CROPPED DATA
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Cropped Data"

'tis where You copy selected columns to CROPPED DATA in specific A-Q order
            Sheets("Imported Data").Columns(SRO).Copy Destination:=Sheets("Cropped Data").Range("A1")
            Sheets("Imported Data").Columns(Desc).Copy Destination:=Sheets("Cropped Data").Range("B1")
            Sheets("Imported Data").Columns(Status).Copy Destination:=Sheets("Cropped Data").Range("C1")
            Sheets("Imported Data").Columns(Project).Copy Destination:=Sheets("Cropped Data").Range("D1")
            Sheets("Imported Data").Columns(SROlead).Copy Destination:=Sheets("Cropped Data").Range("E1")
            Sheets("Imported Data").Columns(OpenDate).Copy Destination:=Sheets("Cropped Data").Range("F1")
            Sheets("Imported Data").Columns(CloseDate).Copy Destination:=Sheets("Cropped Data").Range("G1")
            Sheets("Imported Data").Columns(TPT).Copy Destination:=Sheets("Cropped Data").Range("H1")
            Sheets("Imported Data").Columns(STATUSnew).Copy Destination:=Sheets("Cropped Data").Range("I1")
            Sheets("Imported Data").Columns(WRKstat).Copy Destination:=Sheets("Cropped Data").Range("J1")
            Sheets("Imported Data").Columns(Priority).Copy Destination:=Sheets("Cropped Data").Range("K1")
            Sheets("Imported Data").Columns(CreatedBy).Copy Destination:=Sheets("Cropped Data").Range("L1")
            Sheets("Imported Data").Columns(OpPartner).Copy Destination:=Sheets("Cropped Data").Range("M1")
            Sheets("Imported Data").Columns(DUT).Copy Destination:=Sheets("Cropped Data").Range("N1")
            Sheets("Imported Data").Columns(OpCode).Copy Destination:=Sheets("Cropped Data").Range("O1")
            Sheets("Imported Data").Columns(OpDesc).Copy Destination:=Sheets("Cropped Data").Range("P1")
            Sheets("Imported Data").Columns(OpStatus).Copy Destination:=Sheets("Cropped Data").Range("Q1")

End Sub

Я получаю ошибку:

Ошибка компиляции в скрытом модуле: Generate.

Есть ли другие альтернативы?Как мне перефразировать это, чтобы Excel 365 работал?Мне нужно, чтобы этот код был как можно более легким - обрабатываются тонны данных.

Задача стоит: найти конкретные столбцы заголовков на листе «Импортированные данные» и скопировать их на новый лист «обрезанные данные», но вдругой порядок (и не все!).

1 Ответ

0 голосов
/ 27 июня 2019

Эта проблема вызывается двумя причинами:

  1. В Excel 365 «SRO» является предопределенной константой - поэтому мне нужно было изменить ее на SR0
  2. В Excel 365 должны быть всезначения (например, SR0, Descpt, Stats и т. д.), предопределенные с помощью DIM (так просто):
Private Sub Generate2()

'warning! it's ZERO in all SR0, not O!
        Dim SR0 As Double
        Dim Descpt As Double
        Dim Stats As Double
        Dim Project As Double
        Dim SR0lead As Double
        Dim OpenDate As Double
        Dim CloseDate As Double
        Dim TPT As Double
        Dim STATUSnew As Double
        Dim WRKstat As Double
        Dim OpCode As Double
        Dim Priority As Double
        Dim OpPartner As Double
        Dim DUT As Double
        Dim OpDesc As Double
        Dim OpStatus As Double
        Dim CreatedBy As Double

            Application.EnableEvents = False
            Application.ScreenUpdating = False

                ActiveWorkbook.Sheets("Imported Data").Activate

'tis where You select what columns You want to copy and name them
            SR0 = Application.WorksheetFunction.Match("SroNum", Rows("1:1"), 0)
            Descpt = WorksheetFunction.Match("Description", Rows("1:1"), 0)
            Stats = WorksheetFunction.Match("Status", Rows("1:1"), 0)
            Project = WorksheetFunction.Match("srouf_platform", Rows("1:1"), 0)
            SR0lead = WorksheetFunction.Match("Name", Rows("1:1"), 0)
            OpenDate = WorksheetFunction.Match("CreateDate", Rows("1:1"), 0)
            CloseDate = WorksheetFunction.Match("Close Date", Rows("1:1"), 0)
            TPT = WorksheetFunction.Match("SroTPTinDays", Rows("1:1"), 0)
            STATUSnew = WorksheetFunction.Match("srouf_intel_sro_status", Rows("1:1"), 0)
            WRKstat = WorksheetFunction.Match("Status Code", Rows("1:1"), 0)
            OpCode = WorksheetFunction.Match("OperationCode", Rows("1:1"), 0)
            Priority = WorksheetFunction.Match("Priority Code", Rows("1:1"), 0)
            OpPartner = WorksheetFunction.Match("OperationPartnerName", Rows("1:1"), 0)
            DUT = WorksheetFunction.Match("LineSerialNum", Rows("1:1"), 0)
            OpDesc = WorksheetFunction.Match("OperationDescription", Rows("1:1"), 0)
            OpStatus = WorksheetFunction.Match("OperationStatus", Rows("1:1"), 0)
            CreatedBy = WorksheetFunction.Match("CreatedBy", Rows("1:1"), 0)

'adding new sheet - CROPPED DATA
           Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Cropped Data"

'tis where You copy selected columns to CROPPED DATA in specific A-Q order
            Sheets("Imported Data").Columns(SR0).Copy Destination:=Sheets("Cropped Data").Range("A1")
            Sheets("Imported Data").Columns(Descpt).Copy Destination:=Sheets("Cropped Data").Range("B1")
            Sheets("Imported Data").Columns(Stats).Copy Destination:=Sheets("Cropped Data").Range("C1")
            Sheets("Imported Data").Columns(Project).Copy Destination:=Sheets("Cropped Data").Range("D1")
            Sheets("Imported Data").Columns(SR0lead).Copy Destination:=Sheets("Cropped Data").Range("E1")
            Sheets("Imported Data").Columns(OpenDate).Copy Destination:=Sheets("Cropped Data").Range("F1")
            Sheets("Imported Data").Columns(CloseDate).Copy Destination:=Sheets("Cropped Data").Range("G1")
            Sheets("Imported Data").Columns(TPT).Copy Destination:=Sheets("Cropped Data").Range("H1")
            Sheets("Imported Data").Columns(STATUSnew).Copy Destination:=Sheets("Cropped Data").Range("I1")
            Sheets("Imported Data").Columns(WRKstat).Copy Destination:=Sheets("Cropped Data").Range("J1")
            Sheets("Imported Data").Columns(Priority).Copy Destination:=Sheets("Cropped Data").Range("K1")
            Sheets("Imported Data").Columns(CreatedBy).Copy Destination:=Sheets("Cropped Data").Range("L1")
            Sheets("Imported Data").Columns(OpPartner).Copy Destination:=Sheets("Cropped Data").Range("M1")
            Sheets("Imported Data").Columns(DUT).Copy Destination:=Sheets("Cropped Data").Range("N1")
            Sheets("Imported Data").Columns(OpCode).Copy Destination:=Sheets("Cropped Data").Range("O1")
            Sheets("Imported Data").Columns(OpDesc).Copy Destination:=Sheets("Cropped Data").Range("P1")
            Sheets("Imported Data").Columns(OpStatus).Copy Destination:=Sheets("Cropped Data").Range("Q1")

Надеюсь, это поможет кому-либо еще:)

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...