Не повторять VBA код

Question

У меня есть код VBA, который подключен к UserForm

код ищет заголовки столбцов и заполняет в колонках с этими заголовками, принимая значения из 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 

Answer 2

Попробуйте сделать что-то вроде этого:

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 

Answer 3

Вот как сделать это правильно, рефакторинга кода, так что это многоразовые легко:

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