VBA_Populate 根据匹配文本在单元格之间插入行来用户表单数据

Question

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

我想自动将我的用户表单数据填充到新行（在单元格之间），所以当我们在用户表单文本框中键入 "Text from Remark" 列时，它会自动找到匹配项并在下面的新行中填充数据"Text from Remark"。

示例：当我在用户表单 Texbox 中输入 "Hys(row 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

Answer 1

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

假设您希望在引用 Remark 代码（加上列偏移量为 1）之后恰好一行插入当前文本框值，您的问题是您有

a) 插入整行和
b) 也将此目标偏移 1 行。

此外，我演示了第 [2] 部分的替代方法，即如何使用数组写入所有值，而不是单独分配每个 TextBox 值 - c.f。注释部分 [2a].

顺便说一句，尽量避免使用大部分不必要的 .Activate 和 .Select 方法；您通过完全限定您的范围和 sheet 引用（无论如何都不要怀疑活动引用）来做对了。


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

VBA_Populate 根据匹配文本在单元格之间插入行来用户表单数据

VBA_Populate userform data by insert rows in between cells based on the Matching text

excel

vba

userform