Question

每个人我都是代码和VBA Excell的新手。我有一个Sub可以工作，我只是不确定这是正确的方法，还是不确定是否有更有效的方法，因为运行时需要一段时间才能完成。我只是想知道是否有人可以看看并且可能给我一些指示。

我将代码放在下面，希望我做对了。

谢谢卡莉

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

Answer 1

因此，编程的基本原则是您的函数/子例程应该只有一项工作。我要改进代码的第一步是使用此主体将代码分解为更多的子例程。我不会在此方面做太多深入的介绍，因为已经有大量的资源说明了为什么要这样做。 This thread有一些很好的解释，也有缺点，使您的代码过于繁琐。

我一直做的是从一个名为Main()的子例程开始，该子例程的工作仅仅是调用程序中的其他函数，并在必要时在它们之间传递变量。确保所有函数/子例程都具有描述其用途的名称，然后您只需查看Main，就可以确切知道程序在过程的每个步骤中正在做什么。

如果工作表sheet2上的单元格与工作表sheet1上的单元格匹配，则将行从工作表2复制到工作表1并循环到下一行

1 个答案: