如何縮短偏移代碼VBA

我正在爲工作創建一個項目跟蹤器，並且需要幫助縮短代碼。每個製造商都有自己的表格。我有一個用戶表單，項目經理輸入數據。每個製造工作表都是相同的，並且鏈接到用戶表單的偏移量也是相同的。如何縮短偏移代碼VBA

請參閱下面的代碼。我是編碼新手，可以使用一些幫助。

'A&R 5X9N 
If Me.CB7.Value = "A&R" And Me.CB23.Value = "5x9N" Then 
rowcount = Worksheets("A&R").Range("c3").CurrentRegion.Rows.Count 
With Worksheets("A&R").Range("c1") 

'PROJECT 
.Offset(rowcount, 0) = Me.CB1.Value 
.Offset(rowcount, 1) = Me.TB2.Value 
.Offset(rowcount, 2) = Me.TB3.Value 
.Offset(rowcount, 3) = Me.CB4.Value 
.Offset(rowcount, 4) = Me.CB7.Value 
.Offset(rowcount, 5) = Me.TB1.Value 
'FINISH DATES 
.Offset(rowcount, 7) = Me.TB23.Value 
.Offset(rowcount, 8) = Me.TB24.Value 
.Offset(rowcount, 9) = Me.TB25.Value 
.Offset(rowcount, 10) = Me.TB26.Value 
.Offset(rowcount, 11) = Me.TB27.Value 
.Offset(rowcount, 12) = Me.TB28.Value 
.Offset(rowcount, 13) = Me.TB29.Value 
'PRODUCTION 
.Offset(rowcount, 14) = Me.TB8.Value 
.Offset(rowcount, 15) = Me.TB9.Value 
.Offset(rowcount, 16) = Me.TB10.Value 
.Offset(rowcount, 17) = Me.TB11.Value 
.Offset(rowcount, 18) = Me.TB12.Value 
.Offset(rowcount, 19) = Me.TB13.Value 
.Offset(rowcount, 20) = Me.TB14.Value 
'ASSETS 
.Offset(rowcount, 21) = Me.TB16.Value 
.Offset(rowcount, 22) = Me.TB17.Value 
.Offset(rowcount, 23) = Me.TB18.Value 
.Offset(rowcount, 24) = Me.TB19.Value 
.Offset(rowcount, 25) = Me.TB20.Value 
.Offset(rowcount, 26) = Me.TB21.Value 
.Offset(rowcount, 27) = Me.TB22.Value 
.Offset(rowcount, 28) = Me.CB23.Value 
.Offset(rowcount, 29) = Me.CB24.Value 
.Offset(rowcount, 30) = Me.CB25.Value 
.Offset(rowcount, 31) = Me.CB26.Value 
.Offset(rowcount, 32) = Me.CB27.Value 

End With 
End If 

'A&R 5X10N 
If Me.CB7.Value = "A&R" And Me.CB23.Value = "5x10N" Then 
rowcount = Worksheets("A&R").Range("AM3").CurrentRegion.Rows.Count 
With Worksheets("A&R").Range("AM1") 

'PROJECT 
.Offset(rowcount, 0) = Me.CB1.Value 
.Offset(rowcount, 1) = Me.TB2.Value 
.Offset(rowcount, 2) = Me.TB3.Value 
.Offset(rowcount, 3) = Me.CB4.Value 
.Offset(rowcount, 4) = Me.CB7.Value 
.Offset(rowcount, 5) = Me.TB1.Value 
'FINISH DATES 
.Offset(rowcount, 7) = Me.TB23.Value 
.Offset(rowcount, 8) = Me.TB24.Value 
.Offset(rowcount, 9) = Me.TB25.Value 
.Offset(rowcount, 10) = Me.TB26.Value 
.Offset(rowcount, 11) = Me.TB27.Value 
.Offset(rowcount, 12) = Me.TB28.Value 
.Offset(rowcount, 13) = Me.TB29.Value 
'PRODUCTION 
.Offset(rowcount, 14) = Me.TB8.Value 
.Offset(rowcount, 15) = Me.TB9.Value 
.Offset(rowcount, 16) = Me.TB10.Value 
.Offset(rowcount, 17) = Me.TB11.Value 
.Offset(rowcount, 18) = Me.TB12.Value 
.Offset(rowcount, 19) = Me.TB13.Value 
.Offset(rowcount, 20) = Me.TB14.Value 
'ASSETS 
.Offset(rowcount, 21) = Me.TB16.Value 
.Offset(rowcount, 22) = Me.TB17.Value 
.Offset(rowcount, 23) = Me.TB18.Value 
.Offset(rowcount, 24) = Me.TB19.Value 
.Offset(rowcount, 25) = Me.TB20.Value 
.Offset(rowcount, 26) = Me.TB21.Value 
.Offset(rowcount, 27) = Me.TB22.Value 
.Offset(rowcount, 28) = Me.CB23.Value 
.Offset(rowcount, 29) = Me.CB24.Value 
.Offset(rowcount, 30) = Me.CB25.Value 
.Offset(rowcount, 31) = Me.CB26.Value 
.Offset(rowcount, 32) = Me.CB27.Value 

End With 
End If

來源

2017-01-12 Benjamin Leo Jerome

所以你想讓它更有效率？ – PMARINA

通過使用[Arrays]（https://msdn.microsoft.com/en-us/library/office/gg264224.aspx）和[loops]進行優化（https://www.tutorialspoint.com/vba/vba_for_loop.htm ）。這不會解決你所有的問題，但它應該可以幫助你編寫代碼。 – PMARINA

我會建議去2 subs。駕駛船隻（ProcessRecord）的人以及做出咕嚕作業的人（WriteRecord）。這至少有助於避免重複所有這些抵消。

Private Sub ProcessRecord() 
    If Me.CB7.Value = "A&R" And Me.CB23.Value = "5x9N" Then WriteRecord "A&R", "C3" 
    If Me.CB7.Value = "A&R" And Me.CB23.Value = "5x10N" Then WriteRecord "A&R", "AM1" 
End Sub 

Private Sub WriteRecord(wks As String, rng As String) 
    Dim rowcount As Long 
    rowcount = Worksheets(wks).Range(rng).CurrentRegion.Rows.Count 
    With Worksheets(wks).Range(rng) 
     'PROJECT 
     .Offset(rowcount, 0) = Me.CB1.Value 
     .Offset(rowcount, 1) = Me.TB2.Value 
     .Offset(rowcount, 2) = Me.TB3.Value 
     .Offset(rowcount, 3) = Me.CB4.Value 
     .Offset(rowcount, 4) = Me.CB7.Value 
     .Offset(rowcount, 5) = Me.TB1.Value 
     'FINISH DATES 
     .Offset(rowcount, 7) = Me.TB23.Value 
     .Offset(rowcount, 8) = Me.TB24.Value 
     .Offset(rowcount, 9) = Me.TB25.Value 
     .Offset(rowcount, 10) = Me.TB26.Value 
     .Offset(rowcount, 11) = Me.TB27.Value 
     .Offset(rowcount, 12) = Me.TB28.Value 
     .Offset(rowcount, 13) = Me.TB29.Value 
     'PRODUCTION 
     .Offset(rowcount, 14) = Me.TB8.Value 
     .Offset(rowcount, 15) = Me.TB9.Value 
     .Offset(rowcount, 16) = Me.TB10.Value 
     .Offset(rowcount, 17) = Me.TB11.Value 
     .Offset(rowcount, 18) = Me.TB12.Value 
     .Offset(rowcount, 19) = Me.TB13.Value 
     .Offset(rowcount, 20) = Me.TB14.Value 
     'ASSETS 
     .Offset(rowcount, 21) = Me.TB16.Value 
     .Offset(rowcount, 22) = Me.TB17.Value 
     .Offset(rowcount, 23) = Me.TB18.Value 
     .Offset(rowcount, 24) = Me.TB19.Value 
     .Offset(rowcount, 25) = Me.TB20.Value 
     .Offset(rowcount, 26) = Me.TB21.Value 
     .Offset(rowcount, 27) = Me.TB22.Value 
     .Offset(rowcount, 28) = Me.CB23.Value 
     .Offset(rowcount, 29) = Me.CB24.Value 
     .Offset(rowcount, 30) = Me.CB25.Value 
     .Offset(rowcount, 31) = Me.CB26.Value 
     .Offset(rowcount, 32) = Me.CB27.Value 
    End With 
End Sub

來源

2017-01-12 02:09:30 tlemaster

謝謝大家，這些信息幫助我！ –

下面是如何縮短代碼的示例。這是你的代碼的一塊：

.Offset(rowcount, 7) = Me.TB23.Value 
    .Offset(rowcount, 8) = Me.TB24.Value 
    .Offset(rowcount, 9) = Me.TB25.Value 
    .Offset(rowcount, 10) = Me.TB26.Value 
    .Offset(rowcount, 11) = Me.TB27.Value 
    .Offset(rowcount, 12) = Me.TB28.Value 
    .Offset(rowcount, 13) = Me.TB29.Value 
    'PRODUCTION 
    .Offset(rowcount, 14) = Me.TB8.Value 
    .Offset(rowcount, 15) = Me.TB9.Value 
    .Offset(rowcount, 16) = Me.TB10.Value 
    .Offset(rowcount, 17) = Me.TB11.Value 
    .Offset(rowcount, 18) = Me.TB12.Value 
    .Offset(rowcount, 19) = Me.TB13.Value 
    .Offset(rowcount, 20) = Me.TB14.Value 
    'ASSETS 
    .Offset(rowcount, 21) = Me.TB16.Value 
    .Offset(rowcount, 22) = Me.TB17.Value 
    .Offset(rowcount, 23) = Me.TB18.Value 
    .Offset(rowcount, 24) = Me.TB19.Value 
    .Offset(rowcount, 25) = Me.TB20.Value 
    .Offset(rowcount, 26) = Me.TB21.Value 
    .Offset(rowcount, 27) = Me.TB22.Value

由於所有的值是一個數字順序，並全部以TB，你可以使用一個循環縮短代碼：

For x = 7 To 27 

    If x = 7 Then 
     t = 23 
    ElseIf x = 14 Then 
     t = 8 
    ElseIf x = 21 Then 
     t = 16 
    End If 

    .Offset(rowcount, x) = Me.Controls("TB" & t).Value 
    t = t + 1 

Next x

來源

2017-01-12 02:22:51

這裏的想法：

project = Array(CB1.value, TB2.value, TB3.value, CB4.value, CB7.value, TB1.value) 
.Offset(rowcount, 0).resize(1, Ubound(project)-1).Value = project 

finishDates= Array(TB23.value, TB24.value, TB25.value, TB26.value, TB27.value, TB28.value, TB29.Value) 
.Offset(rowcount, 7).resize(1, Ubound(finishDates)-1).Value = finishDates

等等...

PS如果你的控件是按順序編號的，你可以編寫一個循環來利用它們名字的順序，但這不是你的情況（並不總是AFAICS），而且也不建議指望它，因爲它很難維護。

來源

2017-01-12 02:30:48

可以按如下方式重構代碼：

If Me.CB7.Value = "A&R" Then 'A&R 
     With Worksheets("A&R") 
      Select Case Me.CB23.Value 
       Case "5x9N" '5X9N 
        Write_em .Range("C1"), .Range("C3").CurrentRegion.Rows.Count 

       Case "5x10N" '5X1N 
        Write_em .Range("AM1"), .Range("AM3").CurrentRegion.Rows.Count 
      End Select 
     End With 
    End If

它利用以下Write_em()子：

Sub Write_em(rng As Range, RowCount As Long) 
    With rng 
     'PROJECT 
     .Offset(RowCount, 0) = Me.CB1.Value 
     .Offset(RowCount, 1) = Me.TB2.Value 
     .Offset(RowCount, 2) = Me.TB3.Value 
     .Offset(RowCount, 3) = Me.CB4.Value 
     .Offset(RowCount, 4) = Me.CB7.Value 
     .Offset(RowCount, 5) = Me.TB1.Value 
     'FINISH DATES 
     .Offset(RowCount, 7) = Me.TB23.Value 
     .Offset(RowCount, 8) = Me.TB24.Value 
     .Offset(RowCount, 9) = Me.TB25.Value 
     .Offset(RowCount, 10) = Me.TB26.Value 
     .Offset(RowCount, 11) = Me.TB27.Value 
     .Offset(RowCount, 12) = Me.TB28.Value 
     .Offset(RowCount, 13) = Me.TB29.Value 
     'PRODUCTION 
     .Offset(RowCount, 14) = Me.TB8.Value 
     .Offset(RowCount, 15) = Me.TB9.Value 
     .Offset(RowCount, 16) = Me.TB10.Value 
     .Offset(RowCount, 17) = Me.TB11.Value 
     .Offset(RowCount, 18) = Me.TB12.Value 
     .Offset(RowCount, 19) = Me.TB13.Value 
     .Offset(RowCount, 20) = Me.TB14.Value 
     'ASSETS 
     .Offset(RowCount, 21) = Me.TB16.Value 
     .Offset(RowCount, 22) = Me.TB17.Value 
     .Offset(RowCount, 23) = Me.TB18.Value 
     .Offset(RowCount, 24) = Me.TB19.Value 
     .Offset(RowCount, 25) = Me.TB20.Value 
     .Offset(RowCount, 26) = Me.TB21.Value 
     .Offset(RowCount, 27) = Me.TB22.Value 
     .Offset(RowCount, 28) = Me.CB23.Value 
     .Offset(RowCount, 29) = Me.CB24.Value 
     .Offset(RowCount, 30) = Me.CB25.Value 
     .Offset(RowCount, 31) = Me.CB26.Value 
     .Offset(RowCount, 32) = Me.CB27.Value 
    End With 
End Sub

而且，不僅會縮短代碼的緣故，可以按如下方式重構後者：

Sub Write_em(rng As Range, RowCount As Long) 
    With rng 
     'PROJECT 
     .Offset(RowCount, 0).Resize(, 6).Value = Array(Me.CB1.Value, Me.TB2.Value, Me.TB3.Value, Me.CB4.Value, Me.CB7.Value, Me.TB1.Value) 
     'FINISH DATES 
     WriteTBs .Offset(RowCount, 7), 23, 29 
     'PRODUCTION 
     WriteTBs .Offset(RowCount, 14), 8, 14 
     'ASSETS 
     WriteTBs .Offset(RowCount, 21), 16 27 
    End With 
End Sub 

Sub WriteTBs(rng As Range, iniTB As Integer, endTB As Integer) 
    Dim iTb As Integer, colOffset As Integer 

    With rng 
     For iTb = iniTB To endTB 
      .Offset(, colOffset) = Me.Controls("TB" & iTb).Value 
      colOffset = colOffset + 1 
     Next 
    End With 
End Sub

來源

2017-01-12 09:01:01 user3598756

如何縮短偏移代碼VBA

回答

相關問題