让我们使这个vba代码更有效

时间:2016-01-13 21:00:36

标签: excel vba excel-vba

我是编码新手,并尝试在VBA中进行多次录制和编辑,以便稍微了解一下该做什么。我还浏览了很多网站,以了解VBA的基础知识。我终于完成了我正在研究的这个VBA迷你程序。你们都可以看看它并告诉我我可以改变什么来提高效率或适应其他电子表格吗?

首先,我将其他工作簿中的2个工作表复制并粘贴到此新工作簿中,并在其上使用此程序。第一个工作表将提供有关所有产品和新传入产品的最新信息(没有任何评论)。第二个工作表基本上就是我从前一天生成的工作表(包含其他人在一天中发表的所有评论)。所以基本上它是一个更新程序。大多数情况下,第二个工作表将上升到R列,但有时其他人会删除一列,而最后一列将使用Q代替。因此,如果有人可以提供帮助,我们将非常感激。

我通常开始在截止日期,所有者和位置输入最后3个新列。然后为了确保它们具有与其他字体和间距相同的字体和间距,我将它们相应地更改为相同的字体。之后,我必须通过第二个工作表,并将截止日期,所有者和位置详细信息和注释复制到相应单元格中具有相同序列号(通常在F列)和程序集编号(通常是在E列中。有许多相同的数字,但有些数字对于序列号是相同的,这就是为什么我首先为序列号做了If语句。复制完所有信息后,一些注释会以各种颜色突出显示,因此我必须确保整行也必须突出显示。

之后,我将工作表的所有主体更改为某个字体,然后自动调整列和行,使其看起来更整洁。最后,我按照降序排列第一个电子表格,然后将其复制并粘贴到新的电子表格中,这样它就可以成为一个没有任何宏的常规电子表格。

我不知道如何编写一些代码,所以我只是复制并粘贴了之前尝试过的录制宏。我所做的就是改变它的范围,至少覆盖最后一个条目。

Dim a As Integer
Dim b As Integer
Dim s1 As Worksheet
Dim s2 As Worksheet

Set s1 = ThisWorkbook.Worksheets("Sheet1")
Set s2 = ThisWorkbook.Worksheets("Sheet2")

a = s1.UsedRange.Rows.Count
b = s2.UsedRange.Rows.Count

Cells(1, 19) = "Due Date"
Cells(1, 20) = "Owner"
Cells(1, 21) = "Location"

Rows("1:1").Select
With Selection.Font
    .Name = "Arial"
    .Size = 8
End With
Selection.Font.Bold = True
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
End With
With Selection.Interior
    .Pattern = xlNone
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With

ActiveSheet.Range("$A$1:$U$500").AutoFilter Field:=3, Criteria1:="=WO", _
    Operator:=xlOr, Criteria2:="=WR"
Rows("2:500").Select
Selection.Delete Shift:=xlUp
ActiveSheet.AutoFilterMode = False
ActiveSheet.Range("$A$1:$U$500").AutoFilter Field:=8, Criteria1:= _
    "Inventory"
Selection.Delete Shift:=xlUp
ActiveSheet.AutoFilterMode = False

Dim i As Integer
Dim ii As Integer

i = 2
ii = 2

For i = 2 To a
    For ii = 2 To b
        If s1.Cells(i, 6) = s2.Cells(ii, 6) Then
            If s1.Cells(i, 5) = s2.Cells(ii, 5) Then
                s2.Range(s2.Cells(ii, 18), s2.Cells(ii, 21)).Copy s1.Range(s1.Cells(i, 18), s1.Cells(i, 21))
                s1.Range(s1.Cells(i, 1), s1.Cells(i, 17)).Interior.ColorIndex = Cells(i, 18).Interior.ColorIndex
            End If
        End If
    Next ii
Next i

With Selection.Font
    .Name = "Calibri"
    .Size = 8
End With

Cells.Select
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit

Range("A1").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1"), _
    SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range("A2:U500")
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

1 个答案:

答案 0 :(得分:1)

始终限定您的范围

Cells(1, 19)

应该有工作表限定符

Worksheets("Sheet1").Cells(1, 19)

这可以保持适当的参考。

同时删除所有.Select会降低速度:

此:

Rows("1:1").Select
    With Selection.Font
        .Name = "Arial"
        ...

变为:

With Worksheet("Sheet1").Rows("1:1").Font
    .Name = "Arial"
    ...

或者你可以:

With Worksheet("Sheet1").Rows("1:1")
    With .Font
        .Name = "Arial"
        .Size = 8
        .Bold = True
    End with
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    With .Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End With