VBA 将数据填充到另一列

Question

我会尽量做到易懂。所以我有一个经典的数据输入表单，它有 19 列。根据项目的复杂性，有时我们需要执行额外的步骤，对于我的用户表单，这意味着额外的列。我为这些情况创建了添加按钮，以便在 table 的特定位置添加额外的列。现在问题出现在我的 table 中输入数据，因为每个文本框都有自己的预定位置（列）需要存储数据，但是当我添加列时它必然将数据存储在错误的列中。我的问题是，是否可以制作 if 语句，它会识别出我已经添加了额外的列，并且会根据该语句将其余数据存储到正确的位置。我也在想，如果这样更容易根据我的headers.

的名字填充数据

Sub Submit()

Dim sh As Worksheet
Dim iRow As Long
Set sh = ThisWorkbook.Sheets("PFU")

If frmForm.txtRowNumber.value = "" Then
    iRow = [Counta(PFU!A:A)] + 2
Else
    iRow = frmForm.txtRowNumber.value
End If

With sh
    .Cells(iRow, 1) = iRow - 2
    .Cells(iRow, 2) = frmForm.txtID.value
    .Cells(iRow, 3) = frmForm.txtName.value
    .Cells(iRow, 4) = frmForm.cmbNatureIPR.value
    .Cells(iRow, 5) = frmForm.cmbStatus.value
    .Cells(iRow, 6) = frmForm.txtCity.value
    .Cells(iRow, 7) = frmForm.txtCountry.value
    .Cells(iRow, 8) = frmForm.txtGrantDate.value
    .Cells(iRow, 9) = frmForm.txtGrantNumber.value
    .Cells(iRow, 10) = frmForm.txtAgent.value
    .Cells(iRow, 11) = frmForm.txtCurrentOwner.value
    .Cells(iRow, 12) = frmForm.txtTargetOwner.value
    .Cells(iRow, 13) = frmForm.cmbDVStatus.value
    .Cells(iRow, 14) = frmForm.txtVerifiedOwner.value
    .Cells(iRow, 15) = frmForm.txtVerifiedApp.value
    .Cells(iRow, 16) = frmForm.txtVerifiedGrant.value
    .Cells(iRow, 17) = frmForm.cmbVerifiedStatus.value
    .Cells(iRow, 18) = frmForm.cmbRecAction.value
    .Cells(iRow, 19) = frmForm.txtComment.value
End With

End Sub

这是我的添加按钮代码

Private Sub cmdAddStep_Click()

Dim Table As ListObject
Dim ws As Worksheet

Set ws = Worksheets("PFU")

  If MsgBox("Are you sure you want to add additional colum?", vbYesNo + vbQuestion, "Added") = vbYes 
 Then
Set Table = ws.ListObjects("Table4")
Table.ListColumns.Add 12
Table.HeaderRowRange(12) = "New header"
End If

Call Reset


End Sub

Answer 1

你什么都不说，即使我觉得你应该...我没有时间等。

我准备了一个解决方案，适用于以下情况：您可以插入所需的列数，但您不会像第一次那样在这些列中填充数据代码。代码也可以修改以处理这种情况。不是很复杂。

您必须根据其逻辑构建一个字符串链接 header 列，其中包含使用值的表单控件：

strHeaders = "HeaderB;2|HeaderC;3|HeaderD;4|HeaderE;5|HeaderF;6|HeaderG;7|HeaderH;8|HeaderI;9|HeaderJ;10"

构建逻辑很简单：header与控制标签关联，以“;”分隔。每个 header 由“|”分隔。所以你必须给表单控件分配合适的标签（从2开始）。

Sub SafeInsertOnHeader()
   Dim ws As Worksheet, Table As ListObject, strHeaders As String, h As Long
   Dim arrH As Variant, arrInt As Variant, El As Variant, Ctrl As Control, iRow As Long
   Set ws = ThisWorkbook.Sheets("PFU")
   Set Table = ws.ListObjects("Table1")
   strHeaders = "HeaderB;2|HeaderC;3|HeaderD;4|HeaderE;5|HeaderF;6|HeaderG;7|HeaderH;8|HeaderI;9|HeaderJ;10"
   arrH = Split(strHeaders, "|")

    If frmForm.txtRowNumber.value = "" Then
        iRow = [Counta(PFU!A:A)] + 2
    Else
        iRow = frmForm.txtRowNumber.value
    End If

   ws.Cells(iRow, 1) = iRow - 2 'independent of a control value

   For h = 1 To Table.HeaderRowRange.Count 'iterare through the headers
        For Each El In arrH                'iterate through the array elements
            arrInt = Split(El, ";")        'create each element array (header and tag)
            If Table.HeaderRowRange.Columns(h) = arrInt(0) Then
                For Each Ctrl In frmForm.Controls
                   If Ctrl.Tag = arrInt(1) Then 'for the tag matching the array association
                        ws.Cells(iRow, h).value = Ctrl.value
                   End If
                Next
            End If
        Next
   Next h
End Sub

如果您需要使用新插入的列，在列插入代码中，strHeaders 字符串将被修改为适当的header;tag。该字符串会保存在Registry中，每次Registry读取时都会用到。

下一个方法更简单。您将直接使用 header 名称作为控制标记：

Sub SafeInsertOnHeaderBis()
   Dim ws As Worksheet, Table As ListObject, strHeaders As String, h As Long
   Dim arrH As Variant, El As Variant, Ctrl As Control, iRow As Long
   Set ws = ThisWorkbook.Sheets("PFU")
   Set Table = ws.ListObjects(1) ' ws.ListObjects("Table1")
   strHeaders = "HeaderA|HeaderB|HeaderC|HeaderD|HeaderE|HeaderF|HeaderG|HeaderH|HeaderI|HeaderJ|HeaderK"
   arrH = Split(strHeaders, "|")
    'I used your way of last row determinig but it can be done a little better
    If frmForm.txtRowNumber.value = "" Then
        iRow = [Counta(PFU!A:A)] + 2
    Else
        iRow = frmForm.txtRowNumber.value
    End If

   'Each control will have like tag the header name!
   ws.Cells(iRow, 1) = iRow - 2

   For h = 1 To Table.HeaderRowRange.Count
        For Each El In arrH
            If Table.HeaderRowRange.Columns(h) = El Then
                For Each Ctrl In frmForm.Controls
                   If Ctrl.Tag = El Then
                        ws.Cells(iRow, h).value = Ctrl.value
                   End If
                Next
            End If
        Next
   Next h
End Sub

所以，让我们说，headerA 你必须 select txtID 表单控件，按 F4，才能打开 Properties window，向下滚动直到看到 Tag 属性并用 "headerA" 字符串填充其值。对所有配对进行相同的关联 header/control name，保存表格并享受使用它插入列的乐趣...

VBA 将数据填充到另一列

VBA Fill Data To Another Column

excel

vba

userform