Перенос определенных данных из одного рабочего листа в другой для отчетов - PullRequest
Новая
       10

Перенос определенных данных из одного рабочего листа в другой для отчетов

0 голосов
/ 31 января 2019

У меня есть One Excel Sheets для управления заказами моих клиентов.ниже, пожалуйста, найдите изображение для того же самого.

enter image description here

Прямо сейчас, чтобы спланировать свое производство для материала, я вручную копирую и вставляю данные, чьи заказы "Отгрузить в плане"».чтобы составить отчетный лист, как показано на изображении ниже.

enter image description here

Может ли кто-нибудь посоветовать мне конкретный код VBA или формулу для автоматического размещения данных в листе отчета "Отправка в плане"?

1 Ответ

0 голосов
/ 01 февраля 2019

Это не обязательно вопрос StackOverflow ИМХО, это скорее вопрос «как узнать VBA» - поскольку вы не спрашиваете о конкретной проблеме, решение которой вам нужно.Несмотря на это, я написал немного кода, который должен делать то, что вы описали в своем посте.

Обратите внимание, что он в основном выполняет 0 проверок на ошибки и что выполнение макросов необратимо, поэтому, пожалуйста, сохраните резервную копиюфайлы ваших данных перед началом работы: 

Sub ShipInPlan()
        Dim OrderNum As Long
        Dim StartNum, EndNum As Long
        Dim NumFound As Boolean
        Dim Ws As Worksheet

        'Create input box, so you the user can design which number to ship
        OrderNum = InputBox("For which order Number do you want to create the report?")

        'Find first row of order
        NumFound = False
        Counter = 1

        Do While NumFound = False
            If Sheets("Booking").Cells(Counter, 1).Value <> OrderNum Then
                Counter = Counter + 1
            Else
                NumFound = True
            End If

            If Counter > 500 Then
                NumFound = True
            End If
        Loop

        StartNum = Counter

        'Find last row of order
        Counter = Counter + 1
        NumFound = False

        Do While NumFound = False
            If Len(Sheets("Booking").Cells(Counter, 1).Value) = 0 Then
                Counter = Counter + 1
            Else
                NumFound = True
            End If

            If Counter - NumFound > 500 Then
                NumFound = True
            End If
        Loop

        EndNum = Counter - 2

        'Delete any report sheet that exists then create Sheet
        On Error Resume Next
        Application.DisplayAlerts = False
        Worksheets("Report").Delete
        Set Ws = ThisWorkbook.Sheets.Add(After:= _
                 ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        Ws.Name = "Report"
        Application.DisplayAlerts = True
        On Error GoTo 0

        'Copy contents and go to report sheet
        Sheets("Report").Range("A1:I1").Value = Sheets("Booking").Range("A1:I1").Value
        Sheets("Report").Range(Sheets("Report").Cells(2, 1), Sheets("Report").Cells(1 + EndNum - StartNum, 10)) = Sheets("Booking").Range(Sheets("Booking").Cells(StartNum, 1), Sheets("Booking").Cells(EndNum, 10)).Value
        Sheets("Report").Activate

End Sub
...