Копирование данных на основе ввода критериев с использованием пользовательской формы - PullRequest
Новая
       6

Копирование данных на основе ввода критериев с использованием пользовательской формы

0 голосов
/ 01 октября 2019

Привет и спасибо заранее. Я новичок в Excel vba, и мне нужна помощь по небольшой проблеме.

Я получил задание adhoc от моего босса по использованию Excel VBA для составления отчета. Для этого задания необходимо 2 рабочих тетради. 1 - исходная рабочая книга: Product.xlsx, а другая - целевая рабочая книга: Report Template.xlsx

Что мне нужно сделать, если все критерии, введенные в пользовательской форме, найдены в исходной рабочей книге, то будут скопированы всесвязанные данные. Мне удалось это сделать, но проблема в том, что индекс столбца установлен мной, мне нужна помощь по этому вопросу, если есть способ заменить этот индекс столбца с помощью циклического или другого способа сделать это.

Исходная рабочая книга содержит огромный ряд данных и около 54 столбцов. Данные, которые необходимо вставить в целевую рабочую книгу, должны исключать некоторые столбцы в исходной рабочей книге. Вот мой код: 

Dim LastRow As Long
    Dim i As Long
    Dim erow As Long
    Dim wbk As Workbook
    Dim SourceSheet As Worksheet
    Dim DestSheet As Worksheet
    Dim Fab, Test As String
    Dim Machine, Year, WW As String

    Fab = FabTextBox.Text
    Year = YearComboBox.Text
    WW = WWComboBox.Text
    Test = TestTypeComboBox.Text

    Set SourceSheet = ActiveSheet
    With SourceSheet
        LastRow = .Range("A4").SpecialCells(xlCellTypeLastCell).Row

    If Test = "Test A" Then
        Set wbk = Workbooks.Open("Report Template1.xlsx")
        Set DestSheet = wbk.Sheets("Cover")

    Else
        Set wbk = Workbooks.Open("Report Template2.xlsx")
        Set DestSheet = wbk.Sheets("Cover")
    End If

    With DestSheet
        .Columns(3).NumberFormat = "hh:mm:ss AM/PM"
    End With

    For i = 2 To LastRow

        If SourceSheet.Cells(i, 4).Value = Fab Then
            If SourceSheet.Cells(i, 6).Value = Year Then
                If SourceSheet.Cells(i, 7).Value = WW Then
                    If SourceSheet.Cells(i, 9).Value = Test Then


                        erow = DestSheet.Cells(DestSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Row


                        'change the column numbers to the relevant number
                        DestSheet.Cells(erow, 1).Value = SourceSheet.Cells(i, 2).Value
                        DestSheet.Cells(erow, 2).Value = SourceSheet.Cells(i, 10).Value
                        DestSheet.Cells(erow, 3).Value = SourceSheet.Cells(i, 11).Value
                        DestSheet.Cells(erow, 4).Value = SourceSheet.Cells(i, 12).Value
                        DestSheet.Cells(erow, 5).Value = SourceSheet.Cells(i, 13).Value
                        DestSheet.Cells(erow, 6).Value = SourceSheet.Cells(i, 14).Value
                        DestSheet.Cells(erow, 7).Value = SourceSheet.Cells(i, 15).Value
                        DestSheet.Cells(erow, 8).Value = SourceSheet.Cells(i, 16).Value
                        DestSheet.Cells(erow, 9).Value = SourceSheet.Cells(i, 17).Value
                        DestSheet.Cells(erow, 10).Value = SourceSheet.Cells(i, 18).Value
                        DestSheet.Cells(erow, 11).Value = SourceSheet.Cells(i, 19).Value
                        DestSheet.Cells(erow, 12).Value = SourceSheet.Cells(i, 20).Value
                        DestSheet.Cells(erow, 13).Value = SourceSheet.Cells(i, 21).Value
                        DestSheet.Cells(erow, 14).Value = SourceSheet.Cells(i, 22).Value
                        DestSheet.Cells(erow, 15).Value = SourceSheet.Cells(i, 23).Value
                        DestSheet.Cells(erow, 16).Value = SourceSheet.Cells(i, 24).Value
                        DestSheet.Cells(erow, 17).Value = SourceSheet.Cells(i, 25).Value
                        DestSheet.Cells(erow, 18).Value = SourceSheet.Cells(i, 26).Value
                        DestSheet.Cells(erow, 19).Value = SourceSheet.Cells(i, 27).Value
                        DestSheet.Cells(erow, 20).Value = SourceSheet.Cells(i, 28).Value
                        DestSheet.Cells(erow, 21).Value = SourceSheet.Cells(i, 29).Value
                        DestSheet.Cells(erow, 22).Value = SourceSheet.Cells(i, 30).Value
                        DestSheet.Cells(erow, 23).Value = SourceSheet.Cells(i, 31).Value
                        DestSheet.Cells(erow, 24).Value = SourceSheet.Cells(i, 32).Value
                        DestSheet.Cells(erow, 25).Value = SourceSheet.Cells(i, 33).Value
                        DestSheet.Cells(erow, 26).Value = SourceSheet.Cells(i, 34).Value
                        DestSheet.Cells(erow, 27).Value = SourceSheet.Cells(i, 35).Value
                        DestSheet.Cells(erow, 28).Value = SourceSheet.Cells(i, 36).Value
                        DestSheet.Cells(erow, 29).Value = SourceSheet.Cells(i, 37).Value
                        DestSheet.Cells(erow, 30).Value = SourceSheet.Cells(i, 38).Value
                        DestSheet.Cells(erow, 31).Value = SourceSheet.Cells(i, 39).Value
                        DestSheet.Cells(erow, 32).Value = SourceSheet.Cells(i, 40).Value
                        DestSheet.Cells(erow, 33).Value = SourceSheet.Cells(i, 41).Value
                        DestSheet.Cells(erow, 34).Value = SourceSheet.Cells(i, 42).Value
                        DestSheet.Cells(erow, 35).Value = SourceSheet.Cells(i, 43).Value
                        DestSheet.Cells(erow, 36).Value = SourceSheet.Cells(i, 44).Value
                        DestSheet.Cells(erow, 37).Value = SourceSheet.Cells(i, 45).Value
                        DestSheet.Cells(erow, 38).Value = SourceSheet.Cells(i, 46).Value
                        DestSheet.Cells(erow, 39).Value = SourceSheet.Cells(i, 47).Value
                        DestSheet.Cells(erow, 40).Value = SourceSheet.Cells(i, 48).Value
                        DestSheet.Cells(erow, 41).Value = SourceSheet.Cells(i, 49).Value
                        DestSheet.Cells(erow, 42).Value = SourceSheet.Cells(i, 50).Value
                        DestSheet.Cells(erow, 43).Value = SourceSheet.Cells(i, 51).Value
                        DestSheet.Cells(erow, 44).Value = SourceSheet.Cells(i, 52).Value
                        DestSheet.Cells(erow, 45).Value = SourceSheet.Cells(i, 53).Value
                        DestSheet.Cells(erow, 46).Value = SourceSheet.Cells(i, 54).Value

                    End If
                End If
            End If
        End If
    Next i

И поскольку я знаю, сколько столбцов в наборе данных я пытался заменить своим кодом, как показано ниже, но он не копируется как код выше. Этот код только копирует данные из SourceSheet.Cells(i, 2).Value

    For i = 2 To LastRow
        If SourceSheet.Cells(i, 4).Value = Fab Then
            If SourceSheet.Cells(i, 6).Value = Year Then
                If SourceSheet.Cells(i, 7).Value = WW Then
                    If SourceSheet.Cells(i, 9).Value = Test Then


                        erow = DestSheet.Cells(DestSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                        'change the column numbers to the relevant number
                        DestSheet.Cells(erow, 1).Value = SourceSheet.Cells(i, 2).Value
                        For j = 2 To 46
                            For k = 10 To 54
                                DestSheet.Cells(erow, j).Value = SourceSheet.Cells(i, k).Value
                            Next k
                        Next j
                    End If
                End If
            End If
        End If
    Next i

1 Ответ

1 голос
/ 01 октября 2019

Вы можете скопировать данные в две операции: 

Dim rwSrc as Range   

For i = 2 To LastRow
    Set rwSrc = SourceSheet.Rows(i)
    If rwSrc.Cells(4).Value = Fab Then
        If rwSrc.Cells(6).Value = Year Then
            If rwSrc.Cells(7).Value = WW Then
                If rwSrc.Cells(9).Value = Test Then

                    erow = DestSheet.Cells(DestSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                    With DestSheet.rows(erow)
                        .cells(1).Value = rwSrc.Cells(2).Value
                        'adjust the 50 to match your actual data
                        .cells(2).Resize(1, 50).Value = rwSrc.Cells(10).Resize(1, 50).Value
                    End With
                End If
            End If
        End If
    End If
Next i
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...