不重复VBA代码

我有一个VBA代码，它连接到一个用户窗体

该代码search列标题，并通过从用户窗体中获取值来填充具有这些标题的列

我的问题是：我怎样才能避免重复的代码？

Dim intBB As Integer Dim rngBB As Range intBB = 1 Do While ActiveWorkbook.Worksheets("Sheet1").Cells(1, intBB) <> "" If ActiveWorkbook.Worksheets("Sheet1").Cells(1, intBB).Value = "Block" Then With ActiveWorkbook.Worksheets("Sheet1") Set rngBB = .Range(.Cells(1, intBB), .Cells(1, intBB)) End With Exit Do End If intBB = intBB + 1 Loop ActiveWorkbook.Worksheets("Sheet1").Range(Cells(2, intBB), Cells(LastRow, intBB)).Value = BlockBox.Value intBB = 1 Do While ActiveWorkbook.Worksheets("Sheet1").Cells(1, intBB) <> "" If ActiveWorkbook.Worksheets("Sheet1").Cells(1, intBB).Value = "HPL" Then With ActiveWorkbook.Worksheets("Sheet1") Set rngBB = .Range(.Cells(1, intBB), .Cells(1, intBB)) End With Exit Do End If intBB = intBB + 1 Loop ActiveWorkbook.Worksheets("Sheet1").Range(Cells(2, intBB), Cells(LastRow, intBB)).Value = HPLBox.Value 

Answer 1

也许这个？ 相应地调整w1和w2。

 Sub x() Dim rngBB As Range Dim v, w1, w2, i As Long w1 = Array("Block", "HPL") w2 = Array("Blockbox", "HPLBox") For i = LBound(w1) To UBound(w1) With ActiveWorkbook.Worksheets("Sheet1") v = Application.Match(w1(i), .Rows(1), 0) If IsNumeric(v) Then Set rngBB = .Cells(1, v) .Range(.Cells(2, v), .Cells(LastRow, v)).Value = Me.Controls(w2(i)).Value End If End With Next i End Sub 

Answer 2

这里是如何正确地做到这一点，通过重构代码，使其可以轻松重用：

 Sub test_tombata() Dim wSh As Worksheet Set wSh = ActiveWorkbook.Sheets("Sheet1") Fill_Column_From_Header wSh, "Block", BlockBox.Value Fill_Column_From_Header wSh, "HPL", HPLBox.Value End Sub 

使用sub来填充列的值：

 Sub Fill_Column_From_Header(wS As Worksheet, HeaderName As String, ValueToFill As String) Dim LastRow As Double With wS LastRow = .Cells(.Rows.Count, intBB).End(xlUp).Row wSh.Range(Cells(2, intBB), Cells(LastRow, intBB)).Value = ValueToFill End With 'wS End Sub 

其中使用了一个函数，从头部名称给你列号：

 Function Get_Column_From_Header(wS As Worksheet, HeaderName As String) As Integer Dim intBB As Integer intBB = 1 Get_Column_From_Header = 0 With wS Do While .Cells(1, intBB) <> "" If .Cells(1, intBB).Value <> HeaderName Then Else Get_Column_From_Header = intBB Exit Function End If intBB = intBB + 1 Loop End With 'wS End Function 

我只是补充说，如果这个代码是在一个普通的模块中，你必须使用：
USERFORMNAME.BlockBox.Value而不仅仅是BlockBox.Value

Answer 3

尝试做这样的事情：

 dim wks as worksheet set wks = ActiveWorkbook.Worksheets("Sheet1") With wks call LoopMe("Block", wks) .Range(Cells(2, intBB), Cells(LastRow, intBB)).Value = BlockBox.Value call LoopMe("HPL", wks) .Range(Cells(2, intBB), Cells(LastRow, intBB)).Value = HPLBox.Value End with Public Sub LoopMe(strString as string, wks as worksheet) dim intBB as long : intBB = 1 with wks Do While .Cells(1, intBB) <> "" If .Cells(1, intBB).Value = "Block" Then Set rngBB = .Range(.Cells(1, intBB), .Cells(1, intBB)) Exit Do End If intBB = intBB + 1 Loop end with End Sub