2016-01-13 46 views
-1

我是新來的編碼,並嘗試了許多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 
+7

如果代碼工作打算,你可能沒有意識到在[codereview.se]專門研究這一點:將*工作代碼*轉換爲*偉大的代碼*。只是說;-) –

回答

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 
+1

這是一個很好,簡潔的職位斯科特!我會確保保留一個鏈接,提醒人們限定範圍,並刪除'.Select'是我最常見的評論之一。獎勵! – BruceWayne

+1

@BruceWayne謝謝你,但其他人做得更好。 –

+1

呃,你說得對。這並不好。 :P(當然是在開玩笑) – BruceWayne