Если ячейка на листе 2 строки1 соответствует ячейке на листе 1, скопируйте строку из листа 2 на лист 1 и выполните цикл для следующей строки - PullRequest
0 голосов
/ 04 июля 2019

Все я новичок в коде и VBA Excell. У меня есть саб, который работает, я просто не уверен, что это правильный способ сделать это или есть более эффективный способ, который требует времени для завершения при запуске. Мне просто интересно, может ли кто-нибудь взглянуть и, возможно, дать мне несколько советов.

Я поставлю свой код ниже, я надеюсь, что я делаю это правильно.

Спасибо Карли

Sub DataPopulate()
    Dim wb As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range
    Dim num As Range
    Set wb = ActiveWorkbook
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    Set rng1 = Range("F2")
    Set num = ws1.Range("F2:F4")

'When you click the Click this to populate data MSRP Pricing button you will get the yes no message box.

    If MsgBox("Click yes to continue" & vbCrLf & "Excel may say not responding!!!" _
        & vbCrLf & "It just may take a few moments", vbYesNo + vbQuestion) = vbYes Then
        'If the yes button is pushed in the message box.
        ws1.Activate
        Range("e18") = ("MSRP List")
        'MSRP List text is copied to cell e18.
        Range("h2:h16").Value = Range("g2:g16").Value
        'The product group list is copied from colum g to h.

        ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add2 Key:= _
            Range("f2:f16"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
        With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
            'The numbers in f2~f16 is sorted in assending order along with the product group name.
        End With

        Dim Lastrow As Integer
            Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
            ws1.Activate
            Range("A23:L" & Lastrow).ClearContents ' Select
            'Selection.ClearContents
            'Count from A23 to column L and the last row with data, then select that and delete.
            Range("A22") = ("Group")
            Range("b22") = ("Description")
            Range("c22") = ("Code")
            Range("d22") = ("Barcode")
            Range("e22") = ("List Number")
            'Copy the data list headings

            a = ws2.Cells(Rows.Count, 1).End(xlUp).Row
            'Count rows of CSV data on sheet2 and set veriable for "a" this is the number of times to run the loop below.
            'MsgBox (a) '<testing count number
        For i = 2 To a
        Dim d As Range
            If ws1.Range("f2").Value = ("1") And ws2.Cells(i, 1).Value = ws1.Range("g2") Then
            'Checking if order of product group f2 = 1
            'and if there is a match in sheet2 column A row 1 with G2 in product group list
                    b = ws1.Cells(Rows.Count, 1).End(xlUp).Row
                    ws2.Rows(i).Copy
                    ws1.Cells(b + 1, 1).PasteSpecial Paste:=xlPasteValues
                    'Then copy that row to sheet1 in the next empty row
                End If
                'Loop will do the next rows till "a" times loops are done
            Next

        'This is the same for below until all product groups are done
        For i = 2 To a
            If ws1.Range("f3") = 2 And ws2.Cells(i, 1).Value = ws1.Range("g3") Then
                    b = ws1.Cells(Rows.Count, 1).End(xlUp).Row
                    ws2.Rows(i).Copy
                    ws1.Cells(b + 1, 1).PasteSpecial Paste:=xlPasteValues
                End If
            Next

        For i = 2 To a
            If ws1.Range("f4") = 3 And ws2.Cells(i, 1).Value = ws1.Range("g4") Then
                    b = ws1.Cells(Rows.Count, 1).End(xlUp).Row
                    ws2.Rows(i).Copy
                    ws1.Cells(b + 1, 1).PasteSpecial Paste:=xlPasteValues
                End If
            Next

        Dim rng As Range
        Set rng = Range("F2:f1000")
        'Loop backwards through the rows
        'in the range that you want to evaluate.
        For i = rng.Rows.Count To 1 Step -1

            'If cell i in the range contains an "0", delete the entire row.
            If rng.Cells(i).Value = "0" Then rng.Cells(i).EntireRow.Delete
            'Deleting rows with at 0
        Next

        Application.CutCopyMode = False
        'ThisWorkbook.ws1.calls(1, 22).Select
            ws1.Activate
        Range("A24:E24").Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -4.99893185216834E-02
            .PatternTintAndShade = 0
        End With
        Range("A23:E24").Select
        Selection.Copy
        Application.CutCopyMode = False
        Selection.Copy
        Range("A25:E1000").Select
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        Range("A21").Select
        'Adding grey scale to the rows to make is eazier to read.
        'Else


    End If
End Sub

1 Ответ

0 голосов
/ 04 июля 2019

Таким образом, основной принцип программирования заключается в том, что ваши функции / подпрограммы должны иметь только одну работу. Первым шагом, который я бы предпринял для улучшения вашего кода, было бы разбиение вашего кода на несколько подпрограмм, использующих этот принцип. Я не буду вдаваться в подробности этого преимущества, потому что уже есть множество ресурсов, объясняющих, почему так делать. В этой ветке есть несколько хороших объяснений, а также есть недостатки в том, чтобы так сильно разбить ваш код.

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

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