EXCEL: 使用宏添加记录/添加重复记录

Question

Excel 2019 运行添加数据记录（我不是程序员，但如果没有采用旧 excel 版本的 DATA ENTRY FORM 功能，这应该很容易出去）我创建了一个数据输入 sheet 来更新运行数据库（在另一个 sheet 上）创建了一个添加初始记录的宏子当我需要添加下一条记录时，它会替换上一条记录并添加重复记录。

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

以下代码根据研究修改：

我的宏如下：

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

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

Answer 1

可能是简单的转置

假设您将新的用户表单数据添加到额外表单 sheet 最右边的 wandering 列中，并且您只想将收集到的数据写回水平到目标sheet，您可以通过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] 部分中的右赋值部分由以下计算表单数据 sheet 中最右值的函数执行，因此您正在编码 formdata = getFormData("ACHComplaintsForm")。

此外，该函数将返回的数据范围调整为 1 列，即源数据中最右边的列 ACHComplaintsForm（其中 sheet 名称作为字符串参数传递，起始行默认到 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

EXCEL: 使用宏添加记录/添加重复记录

EXCEL: adding records using macro /duplicate records added

excel

vba

userform