Excel VBA_通过基于匹配文本在单元格之间插入行来填充用户表单数据

在我的excel文档中，我有以下信息：

我想自动将我的userform数据填充到新行（在单元格之间），因此当我们在userform文本框中键入“Text from Remark”列时，它会自动找到匹配项并在“Text from Remark”下面的新行中填充数据

示例：当我在Userform文本框中输入“Hys（第4行）”时，代码应该找到“Hys”，并用新行（第5行）传输“Hys”下方的新数据，并在输入新数据时再次重复相同的操作

所需输出如下图所示：

我尝试了下面的代码，但无法获得所需的输出，我可以将单元格移动到新行，但不能插入新行

Private Sub cmdadd_Click()

    Dim fvalue As Range
    Dim wks As Worksheet
    Set wks = ThisWorkbook.Worksheets("Sheet1")
    wks.Activate
    Set fvalue = wks.Range("B:B").Find(What:=Me.txtremark.Value, LookIn:=xlFormulas, LookAt:=xlWhole)
    fvalue.Value = Me.txtremark.Value
    fvalue.Insert shift:=xlDown
    fvalue.Offset(0, 1).Value = Me.txtplace.Value
    fvalue.Offset(0, 2).Value = Me.txtstart.Value
    fvalue.Offset(0, 3).Value = Me.txtend.Value

End Sub

---

在匹配文本后在行中插入控制值

假设您希望每次插入当前文本框值时正好在引用备注代码后一行（加上列偏移量1），您的问题是

• a） 插入整行并
• b） 也将此目标偏移1行

此外，我还演示了

[2]

部分的另一种替代方法，即如何使用数组写入所有值，而不是单独分配每个文本框值-c.f.超出注释部分

[2a]

顺便说一句，尽量避免使用最不必要的

。激活
和
。选择
方法；通过完全限定范围和工作表引用，您做到了正确的操作（无论如何都不要怀疑活动引用）

对于使用Excel数据，您不希望数据块中有空格。例如，对于所有三个结果条目，您希望在各自的单元格中包含
1
和
Hys
（其他条目也是如此）。如果您将代码更新为包含这些数据，那么您可以简单地将数据添加到表的底部，然后进行排序以将数据放在适当的位置。甚至可以有一个隐藏列，其中包含添加条目的日期/时间戳，然后将该列用作子排序以保留所需的顺序。我添加了此代码fvalue.EntireRow.Copyfvalue.Offset（-1）.EntireRow.Insert Shift:=xlDown
使用此选项，我可以在新行中看到新数据，但偏移量未按要求显示。你能纠正一下吗！

Private Sub cmdadd_Click()
    Dim fvalue As Range
    Dim wks    As Worksheet
    Set wks = ThisWorkbook.Worksheets("Sheet1")
    Set fvalue = wks.Range("B:B").Find(What:=Me.txtremark.Value, LookIn:=xlFormulas, LookAt:=xlWhole)
    If fvalue Is Nothing Then
    ' do something if nothing found
    ' (e.g. add new title rows and reset fvalue OR Exit Sub displaying a message)
    ' ...
    End If

      ' [1] insert a) ENTIRE row b) ONE row (=offset 1) after the found remark cell
        fvalue.Offset(1).EntireRow.Insert shift:=xlDown

      ' [2] write values to newly inserted row, i.e. 1 row after found cell
        fvalue.Offset(1, 1).Value = Me.txtplace.Value
        fvalue.Offset(1, 2).Value = Me.txtstart.Value
        fvalue.Offset(1, 3).Value = Me.txtend.Value

      '' [2a] or alternatively with less code lines using an array with all values:
      '   Dim arr()
      '   arr = Array(Me.txtplace, Me.txtstart, Me.txtend)
      '   fvalue.Offset(1, 1).Resize(1, UBound(arr) + 1) = arr

    End If
End Sub