EXCEL：使用添加的宏/重复记录添加记录

Question

Excel 2019正在运行添加数据记录（我不是程序员，但是如果未取出旧版excel中的DATA ENTRY FORM函数，这应该很容易） 我创建了一个数据输入表来更新正在运行的数据库（在另一个表上） 创建了一个宏子，添加了初始记录 当我需要添加下一条记录时，它将替换上一条记录并添加重复的记录。

我能够成功创建第一条记录。添加下一条不同的记录是我失败的地方。

以下代码是根据研究得出的：VBA Entering userform data at next blank row correctly

我的宏如下：

Sub UpdateComplaintsTest()

' UpdateComplaintTest Macro

    Set ws = Sheets("ACH Complaints 2019")

    LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1 'Finds the last blank row

    ws.Range("A" & LastRow).Value = "=ACHComplaintsForm!B3" 'Inserts the Date Col A
    ws.Range("A" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B4" 'Inserts Time Col B
    ws.Range("B" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B5" 'Inserts Name of Complainant Col C
    ws.Range("C" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B6" 'Sender's Contact No Col D
    ws.Range("D" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B7" 'Sender's Email Col E
    ws.Range("E" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B8" 'Date of Transaction Col F
    ws.Range("F" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B9" 'Time of Transaction Col G
    ws.Range("G" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B10" 'Transaction Ref No Col H
    ws.Range("H" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B11" 'Mode of Tran / Online/Mobile Col I
    ws.Range("I" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B12" 'Name of Clearing House Col J
    ws.Range("J" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B13" 'Sending Bank Col K
    ws.Range("K" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B14" 'Receiving Bank Col L
    ws.Range("L" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B15" 'Amount Col M
    ws.Range("M" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B16" 'Receiver Name Col N
    ws.Range("N" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B17" ' Receiver Contact No Col O
    ws.Range("O" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B18" 'Receiver Email Col P
    ws.Range("P" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B19" 'Receiver AccountNo Col Q
    ws.Range("Q" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B20" 'History of Trans Col R
    ws.Range("R" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B21" 'Action 1 Col S
    ws.Range("S" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B22" 'Action 2 Col T
    ws.Range("T" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B23" 'Action 3 Col U

End Sub

预期结果：数据输入表中的其他条目应在下一行创建新记录。

Answer 1

可能简单的换位

假设您将新的用户表单数据添加到额外的表单最右边的 列中，而您只想将收集的数据水平写回目标表单，则可以通过Application.Transpose使用以下方法来交换中间formdata数组的行和列。

 Option Explicit                 ' declaration head of Code module

 Sub UpdateComplaintsTest()

    ' [1] assign vertical data column to 2-dimensioned 1-based array formdata
          Dim formdata()         As Variant
          formdata = getFormData("ACHComplaintsForm")    
    ' [2] write data horizontally (i.e. transpose data column from variant array formdata)                                            
          nextTargetRange("ACH Complaints 2019", UBound(formdata), "A").Value = Application.Transpose(formdata)

End Sub

第getFormData()节调用的辅助函数[1]

可以通过一条代码行将整个范围分配给变量数组， 例如通过formdata = Thisworkbook.Worksheets("XY").Range("B3:Z1000").Value。 由于[1]节中的权限分配部分由以下函数执行，该函数计算了表单数据表中最正确的值，因此您正在编码formdata = getFormData("ACHComplaintsForm")。

此外，该函数将返回的数据范围调整为1列，即源数据ACHComplaintsForm中最右边的列（其中工作表名称作为字符串参数传递，并且可以选择将起始行默认为3） ）。

Function getFormData(ByVal DataSheet As String, Optional ByVal StartRow As Long = 3) As Variant()
' Purpose: return 2-dim 1-based array containing latest data column (i.e. most right column)
' Note:    Function assumes data start at 3rd row
    With ThisWorkbook.Worksheets(DataSheet)
        '[a] define number of most right column
             Dim nextCol As Long
             nextCol = .Cells(StartRow, .Columns.Count).End(xlToLeft).Column
        '[b] define number of items in this data column
             Dim Itemscount  As Long
             Itemscount = .Cells(.Rows.Count, nextCol).End(xlUp).Row - StartRow + 1

        '[c] return column data as variant 2-dim 1-based array
             getFormData = .Cells(StartRow, nextCol).Resize(Itemscount, 1).Value
             'Debug.Print "Form Data Range " & .Cells(StartRow, nextCol).Resize(Itemscount, 1).Address
    End With

End Function

第nextTargetRange()节调用的辅助函数[2]

此功能只是将目标行范围调整为必要的大小，以接收指示数量的源项目。

Function nextTargetRange(ByVal TargetSheet As String, Itemscount As Long, Optional ByVal StartCol As String = "A") As Range
' Purpose: return next free row range to receive needed data starting at a given column
  With ThisWorkbook.Worksheets(TargetSheet)
    ' [a] define next free row
          Dim nextFreeRow As Long
          nextFreeRow = .Range(StartCol & Rows.Count).End(xlUp).Row + 1
    ' [b] return function result, i.e. the receiving target range
          Set nextTargetRange = .Range(StartCol & nextFreeRow).Resize(1, Itemscount)
          'Debug.Print "Target Range " & nextTarget.Address
  End With
End Function

Answer 2

您可以尝试一下，我认为这可以解决您的问题

Sub UpdateComplaintsTest()

' UpdateComplaintTest Macro

Set ws = Sheets("ACH Complaints 2019")

LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1 'Finds the last blank row

ws.Range("A" & LastRow).Value = "=ACHComplaintsForm!B3" 'Inserts the Date Col A
ws.Range("A" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B4" 'Inserts Time Col B
ws.Range("B" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B5" 'Inserts Name of Complainant Col C
ws.Range("C" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B6" 'Sender's Contact No Col D
ws.Range("D" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B7" 'Sender's Email Col E
ws.Range("E" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B8" 'Date of Transaction Col F
ws.Range("F" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B9" 'Time of Transaction Col G
ws.Range("G" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B10" 'Transaction Ref No Col H
ws.Range("H" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B11" 'Mode of Tran / Online/Mobile Col I
ws.Range("I" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B12" 'Name of Clearing House Col J
ws.Range("J" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B13" 'Sending Bank Col K
ws.Range("K" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B14" 'Receiving Bank Col L
ws.Range("L" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B15" 'Amount Col M
ws.Range("M" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B16" 'Receiver Name Col N
ws.Range("N" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B17" ' Receiver Contact No Col O
ws.Range("O" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B18" 'Receiver Email Col P
ws.Range("P" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B19" 'Receiver AccountNo Col Q
ws.Range("Q" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B20" 'History of Trans Col R
ws.Range("R" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B21" 'Action 1 Col S
ws.Range("S" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B22" 'Action 2 Col T
ws.Range("T" & LastRow).Offset(0, 1).Value = "=ACHComplaintsForm!B23" 'Action 3 Col U

ThisWorkbook.Save

End Sub