VBA:在代码修改中寻求帮助

Question

我是一名 VBA 学习者，我正在尝试构建一个 VBA 项目来提高我的知识。关于如何将不同的数据(基于某些条件)填充到一组相同的字段中存在轻微的混淆。

我有3个场景:

场景 1:用户选中所有复选框
场景 2:用户仅选择 1 或 2 个复选框
场景 3:用户没有选择任何东西

我的代码将与场景 1 和 3 完美配合，但无法弄清楚如何完成场景 2。

我的期望是根据用户在用户窗体弹出给他时选择的内容填充从单元格 B3 到 B17 的值。如果他只选择 1 个字段对应的值应该从 B3 - B8 填充，如果他选择 2 个复选框，则第一个对应的值将从 B3 - B8 填充，第二组从 B9 - B14 填充，依此类推。请找到下面的图片以便更好地理解

用户表单


场景一示例


场景 3 示例


VBA代码

Dim i As Integer
i = 3
Do While i < 8 And UF1_Location_and_Role.CheckBox6.Value = True
    Cells(i, 2).Value = "India"
    i = i + 1
Loop

Do While i < 13 And UF1_Location_and_Role.CheckBox7.Value = True
    Cells(i, 2).Value = "Germany"
    i = i + 1
Loop

Do While i < 18 And UF1_Location_and_Role.CheckBox7.Value = True
    Cells(i, 2).Value = "Hongkong"
    i = i + 1
Loop

Answer 1

我认为您想要更像下面的代码。此代码可以进一步改进为一个函数，您可以将国家名称和当前行传递给该函数，从而消除重复代码

 Sub PopulateSheet()
 Dim lngCurrentRow As Long

'start row
lngCurrentRow = 3

If chkIndia Then

    Sheet.Range("B" & lngCurrentRow & ":B" & lngCurrentRow + 4) = "India"

    lngCurrentRow = lngCurrentRow + 5

End If

 If chkGermany Then

    Sheet.Range("B" & lngCurrentRow & ":B" & lngCurrentRow + 4) = "Germany"

    lngCurrentRow = lngCurrentRow + 5

End If


If chkHK Then

    Sheet.Range("B" & lngCurrentRow & ":B" & lngCurrentRow + 4) = "Hong Kong"

    lngCurrentRow = lngCurrentRow + 5

End If

End Sub

更新功能:

Sub PopulateSheet()
Dim lngCurrentRow As Long

'start row
lngCurrentRow = 3

If chkIndia Then Call WriteOutput("India", lngCurrentRow)
If chkGermany Then Call WriteOutput("Germany", lngCurrentRow)
If chkHK Then Call WriteOutput("Hong Kong", lngCurrentRow)

End Sub

Function WriteOutput(strCountry As String, ByRef lngRowToWriteTo As Long)

ActiveSheet.Range("B" & lngRowToWriteTo & ":B" & lngRowToWriteTo + 4) = strCountry

lngRowToWriteTo = lngRowToWriteTo + 5

End Function

然后，您可以将 4 设置为常数(您希望国家/地区出现在工作表中的次数)，将 5 设置为常数 + 1

用常数更新，这提供了最大的灵 active :

    Private Const START_ROW As Long = 3
    Private Const NUM_COUNTRY_ROWS As Long = 4
    Private Const COLUMN_TO_WRITE_TO As String = "B"

    Sub PopulateSheet()
    Dim lngCurrentRow As Long

        'start row
        lngCurrentRow = START_ROW

        If True Then Call WriteOutput("India", lngCurrentRow)
        If True Then Call WriteOutput("Germany", lngCurrentRow)
        If True Then Call WriteOutput("Hong Kong", lngCurrentRow)

    End Sub

    Function WriteOutput(strCountry As String, ByRef lngRowToWriteTo As Long)

        ActiveSheet.Range(COLUMN_TO_WRITE_TO & lngRowToWriteTo & ":" & COLUMN_TO_WRITE_TO & lngRowToWriteTo + NUM_COUNTRY_ROWS) = strCountry

        lngRowToWriteTo = lngRowToWriteTo + NUM_COUNTRY_ROWS + 1

    End Function

已更新以包括合并(请注意，您现在只需将国家/地区写入一次)

Private Const START_ROW As Long = 3
Private Const NUM_COUNTRY_ROWS As Long = 4
Private Const COLUMN_TO_WRITE_TO As String = "B"

Sub PopulateSheet()
Dim lngCurrentRow As Long

    'start row
    lngCurrentRow = START_ROW

    If chkIndia Then Call WriteOutput("India", lngCurrentRow)
    If chkGermany Then Call WriteOutput("Germany", lngCurrentRow)
    If chkHK Then Call WriteOutput("Hong Kong", lngCurrentRow)

End Sub

Function WriteOutput(strCountry As String, ByRef lngRowToWriteTo As Long)

    With ActiveSheet

        .Range(COLUMN_TO_WRITE_TO & lngRowToWriteTo) = strCountry

        .Range(.Range(COLUMN_TO_WRITE_TO & lngRowToWriteTo), .Range(COLUMN_TO_WRITE_TO & lngRowToWriteTo + NUM_COUNTRY_ROWS)).Cells.Merge

    End With

    lngRowToWriteTo = lngRowToWriteTo + NUM_COUNTRY_ROWS + 1

End Function