不重复VBA代码

Question

我有一个VBA代码,它连接到用户表单

代码通过获取userform中的值来搜索列标题并使用这些标题填充列

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

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