Question

我在单元格G3:G102中有一个下拉列表，您可以在其中选择1到50之间的值。通过从列表中选择一个数字，接下来的三列将由VBA填充，例如： / p>

1.
2.
3.

和

On floor 1: ?
On floor 2: ?
On floor 3: ?

所以我有这个VBA代码。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Set KeyCells = Range("G3:G102")

    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then

        ' If any one of these cells in the range KeyCells has been modified, then retrieve its value
        floorValue = Range(Target.Address)

        ' Here is the loop I use it will loop X-amount of times based on the number from 'KeyCells'
        Dim i As Integer

        For i = 1 To Range(Target.Address).Value
        ' myText and myText2 are two variables that I am populating here with multiple lines.
            myText = myText & i & "." & vbNewLine
            myText2 = myText2 & "On floor " & i & ": ?" & vbNewLine
        Next i


        'Then insert that data into the cells to the right
        Target.Offset(0, 1).Value = myText
        Target.Offset(0, 2).Value = myText2
        Target.Offset(0, 3).Value = myText2


    End If
End Sub

我遇到的问题

如果我同时粘贴到多个单元格中，或者同时将数据移动到多个单元格中，则将出现Type mismatch错误，特别是在这一点上： For i = 1 To Range(Target.Address).Value

Answer 1

我认为，最终，您需要的是这样的东西

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim KeyCells As Range
    Dim KeyCell As Range
    Dim floorValue As Long
    Dim myText As String
    Dim myText2 As String
    Dim i As Long

    Set KeyCells = Intersect(Me.Range("G3:G102"), Target)

    Application.EnableEvents = False

    If Not KeyCells Is Nothing Then
        For Each KeyCell In KeyCells.Cells
            myText = vbNullString
            myText2 = vbNullString

            ' If any one of these cells in the range KeyCells has been modified, then retrieve its value
            floorValue = KeyCell.Value

            ' Here is the loop I use it will loop X-amount of times based on the number from 'KeyCells'
            For i = 1 To floorValue
                'myText and myText2 are two variables that I am populating here with multiple lines.
                myText = myText & i & "." & vbNewLine
                myText2 = myText2 & "On floor " & i & ": ?" & vbNewLine
            Next i

            'Then insert that data into the cells to the right
            KeyCell.Offset(0, 1).Value = myText
            KeyCell.Offset(0, 2).Value = myText2
            KeyCell.Offset(0, 3).Value = myText2
        Next KeyCell
    End If

    Application.EnableEvents = True

End Sub

Answer 2

粘贴多个值时，环绕范围中的每个单元格。这应该修复它，未经测试。

    Dim rng as Range
    For each rng in Range(Target.Address)
        'myText and myText2 are two variables that I am populating here with multiple lines.
        myText = myText & rng.value & "." & vbNewLine
        myText2 = myText2 & "On floor " & rng.value & ": ?" & vbNewLine
        rng.Offset(0, 1).Value = myText
        rng.Offset(0, 2).Value = myText2
        rng.Offset(0, 3).Value = myText2
    Next

将数据粘贴到多个单元格中并使用循环时，键入Mimatch VBA

2 个答案: