我的if语句很健壮。如何使其更紧凑？

时间：2019-08-07 09:23:14

标签： excel vba

我有一个robus代码可以完成其工作，但是很难看。该代码根据“数据”表的ItemType提取值，并将其复制到适当的工作表中。听起来很简单。但是，存在一些美学缺陷，例如删除了网格线并且扭曲了单元格格式。 我将不胜感激任何帮助或建议。 

Option Explicit
Sub test()

Dim LastRow As Long, i As Long
'-----------Mfg FG
Dim rng1 As Range
'-----------Mfg RAW
Dim rng2 As Range
'-----------Mfg Sub-Assy
Dim rng3 As Range
'-----------Resale
Dim rng4 As Range
'-----------Conv Resale
Dim rng5 As Range
'-----------Mfg FG PE
Dim rng6 As Range
'-----------Mfg Sub-Assy PE
Dim rng7 As Range
'-----------Acrylics
Dim rng8 As Range
'-----------Mfg Raw PE
Dim rng9 As Range
'-----------Mfg FG PVC
Dim rng10 As Range
'-----------Mfg Raw PVC
Dim rng11 As Range
'-----------Mfg Sub-Assy PVC
Dim rng12 As Range

'--------------------------------------------------------

Set rng1 = Worksheets("ABCX Mfg FG").Range("A13:C1370")
Set rng2 = Worksheets("ABCX Mfg RAW").Range("A13:C1370")
Set rng3 = Worksheets("ABCX Mfg Sub-Assy").Range("A13:C1370")
Set rng4 = Worksheets("ABCX Resale").Range("A13:C1370")
Set rng5 = Worksheets("ABCX Conv Resale").Range("A13:C1370")
Set rng6 = Worksheets("ABCX Mfg FG PE").Range("A13:C1370")
Set rng7 = Worksheets("ABCX Mfg Sub-Assy PE").Range("A13:C1370")
Set rng8 = Worksheets("ABCX Acrylics").Range("A13:C1370")
Set rng9 = Worksheets("ABCX Mfg Raw PE").Range("A13:C1370")
Set rng10 = Worksheets("ABCX Mfg FG PVC").Range("A13:C1370")
Set rng11 = Worksheets("ABCX Mfg Raw PVC").Range("A13:C1370")
Set rng12 = Worksheets("ABCX Mfg Sub-Assy PVC").Range("A13:C1370")

'---------------------------------------------------------

   With Worksheets("Data")
      LastRow = .Range("A" & .Rows.Count).End(xlUp).Row

      For i = 2 To LastRow

        If .Cells(i, 6) = "Mfg FG" Then
          With Worksheets("ABCX Mfg FG")

            .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = _
               Worksheets("Data").Cells(i, 1).Value

            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 1) = _
               Worksheets("Data").Cells(i, 8).Value

            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 2) = _
               Worksheets("Data").Cells(i, 9).Value

            rng1.RemoveDuplicates Columns:=Array(1, 2, 3)

          End With
        End If

        If .Cells(i, 6) = "Mfg RAW" Then
          With Worksheets("ABCX Mfg RAW")

            .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = _
               Worksheets("Data").Cells(i, 1).Value

            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 1) = _
               Worksheets("Data").Cells(i, 8).Value

            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 2) = _
               Worksheets("Data").Cells(i, 9).Value

            rng2.RemoveDuplicates Columns:=Array(1, 2, 3)

          End With
        End If

        If .Cells(i, 6) = "Mfg Sub-Assy" Then
          With Worksheets("ABCX Mfg Sub-Assy")

            .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = _
               Worksheets("Data").Cells(i, 1).Value

            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 1) = _
               Worksheets("Data").Cells(i, 8).Value

            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 2) = _
               Worksheets("Data").Cells(i, 9).Value

            rng3.RemoveDuplicates Columns:=Array(1, 2, 3)

          End With
        End If

        If .Cells(i, 6) = "Resale" Then
          With Worksheets("ABCX Resale")

            .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = _
               Worksheets("Data").Cells(i, 1).Value

            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 1) = _
               Worksheets("Data").Cells(i, 8).Value

            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 2) = _
               Worksheets("Data").Cells(i, 9).Value

            rng4.RemoveDuplicates Columns:=Array(1, 2, 3)

          End With
        End If

        If .Cells(i, 6) = "Conv Resale" Then
          With Worksheets("ABCX Conv Resale")

            .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = _
               Worksheets("Data").Cells(i, 1).Value

            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 1) = _
               Worksheets("Data").Cells(i, 8).Value

            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 2) = _
               Worksheets("Data").Cells(i, 9).Value

            rng5.RemoveDuplicates Columns:=Array(1, 2, 3)

          End With
        End If

        If .Cells(i, 6) = "Mfg FG PE" Then
          With Worksheets("ABCX Mfg FG PE")

            .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = _
               Worksheets("Data").Cells(i, 1).Value

            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 1) = _
               Worksheets("Data").Cells(i, 8).Value

            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 2) = _
               Worksheets("Data").Cells(i, 9).Value

            rng6.RemoveDuplicates Columns:=Array(1, 2, 3)

          End With
        End If

        If .Cells(i, 6) = "Mfg Sub-Assy PE" Then
          With Worksheets("ABCX Mfg Sub-Assy PE")

            .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = _
               Worksheets("Data").Cells(i, 1).Value

            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 1) = _
               Worksheets("Data").Cells(i, 8).Value

            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 2) = _
               Worksheets("Data").Cells(i, 9).Value

            rng7.RemoveDuplicates Columns:=Array(1, 2, 3)

          End With
        End If

        If .Cells(i, 6) = "Acrylics" Then
          With Worksheets("ABCX Acrylics")

            .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = _
               Worksheets("Data").Cells(i, 1).Value

            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 1) = _
               Worksheets("Data").Cells(i, 8).Value

            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 2) = _
               Worksheets("Data").Cells(i, 9).Value

            rng8.RemoveDuplicates Columns:=Array(1, 2, 3)

          End With
        End If

        If .Cells(i, 6) = "Mfg Raw PE" Then
          With Worksheets("ABCX Mfg Raw PE")

            .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = _
               Worksheets("Data").Cells(i, 1).Value

            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 1) = _
               Worksheets("Data").Cells(i, 8).Value

            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 2) = _
               Worksheets("Data").Cells(i, 9).Value

            rng9.RemoveDuplicates Columns:=Array(1, 2, 3)

          End With
        End If

        If .Cells(i, 6) = "Mfg FG PVC" Then
          With Worksheets("ABCX Mfg FG PVC")

            .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = _
               Worksheets("Data").Cells(i, 1).Value

            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 1) = _
               Worksheets("Data").Cells(i, 8).Value

            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 2) = _
               Worksheets("Data").Cells(i, 9).Value

            rng10.RemoveDuplicates Columns:=Array(1, 2, 3)

          End With
        End If


                If .Cells(i, 6) = "Mfg Raw PVC" Then
          With Worksheets("ABCX Mfg Raw PVC")

            .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = _
               Worksheets("Data").Cells(i, 1).Value

            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 1) = _
               Worksheets("Data").Cells(i, 8).Value

            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 2) = _
               Worksheets("Data").Cells(i, 9).Value

            rng11.RemoveDuplicates Columns:=Array(1, 2, 3)

          End With
        End If

               If .Cells(i, 6) = "Mfg Sub-Assy PVC" Then
          With Worksheets("ABCX Mfg Sub-Assy PVC")

            .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = _
               Worksheets("Data").Cells(i, 1).Value

            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 1) = _
               Worksheets("Data").Cells(i, 8).Value

            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 2) = _
               Worksheets("Data").Cells(i, 9).Value

            rng12.RemoveDuplicates Columns:=Array(1, 2, 3)

          End With
        End If

       Next i

    End With

End Sub

1 个答案:

答案 0 :(得分：1)

也许像这样：

您可以使用Select Case并摆脱多余的范围定义，因为它们对于所有图纸都是相同的。

Option Explicit
Sub test()

Dim LastRow As Long, i As Long

With Worksheets("Data")

LastRow = .Range("A" & .Rows.Count).End(xlUp).row


For i = 2 To LastRow

    Select Case .Cells(i, 6)

    Case "Mfg FG"
        Call act(Worksheets("ABCX Mfg FG"), i)
    Case "Mfg RAW"
        Call act(Worksheets("ABCX Mfg RAW"), i)
    Case "Mfg Sub-Assy"
        Call act(Worksheets("ABCX Mfg Sub-Assy"), i)
    Case "Resale"
        Call act(Worksheets("ABCX Resale"), i)
    Case "Conv Resale"
        Call act(Worksheets("ABCX Conv Resale"), i)
    Case "Mfg FG PE"
        Call act(Worksheets("ABCX Mfg FG PE"), i)
    Case "Mfg Sub-Assy PE"
        Call act(Worksheets("ABCX Mfg Sub-Assy PE"), i)
    Case "Acrylics"
        Call act(Worksheets("ABCX Acrylics"), i)
    Case "Mfg Raw PE"
        Call act(Worksheets("ABCX Mfg Raw PE"), i)
    Case "Mfg FG PVC"
        Call act(Worksheets("ABCX Mfg FG PVC"), i)
    Case "Mfg Raw PVC"
        Call act(Worksheets("ABCX Mfg Raw PVC"), i)
    Case "Mfg Sub-Assy PVC"
        Call act(Worksheets("ABCX Mfg Sub-Assy PVC"), i)
    End Select
    Next i

End With

End Sub


Sub act(wks As Worksheet, j As Long)

    With wks

      .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = _
         Worksheets("Data").Cells(j, 1).Value

      .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 1) = _
         Worksheets("Data").Cells(j, 8).Value

      .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 2) = _
         Worksheets("Data").Cells(j, 9).Value

      .Range("A13:C1370").RemoveDuplicates Columns:=Array(1, 2, 3)

    End With

End Sub
相关问题
最新问题