如何缩短偏移代码VBA

我正在创build一个项目跟踪工作，需要帮​​助缩短代码。 每个制造商都有自己的表格。 我有一个用户窗体，项目经理input数据。每个制造工作表是相同的，链接到用户窗体的偏移也是一样的。

请参阅下面的代码。 我是新来的编码，可以使用一些帮助。

'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 

Answer 1

我会build议去2潜艇。 一个驱动船（ProcessRecord）和一个做咕噜工作（WriteRecord）。 这至less有助于避免重复所有这些抵消。

 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 

Answer 2

这是这个想法：

 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），而且也不build议指望它，因为它很难维护。

Answer 3

这里是一个如何缩短代码的例子。 这是你的代码中的一部分：

  .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 

Answer 4

你可以重构你的代码，如下所示：

  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