Question

我有一个手动构建的表单，该表单在Excel工作表VolunteerForm中看起来大致像这样：

，工作表VolunteerData中的数据库链接到以下表单：

我设法链接了信息的第一部分（数据库中的Col A到F），但是没有链接表格的下半部分。

这是我到目前为止所做的（请注意，我已构建代码，但由于运行代码给我一个错误，因此无法弄清楚如何修改它们以得到所需的结果）。

这是我的代码：

Sub Submit_VolunteerForm()

   Dim lr As Long, ws As Worksheet
   Dim arr As Variant, i As Long

    With Worksheets("VolunteerForm")
       lr = .Cells(12, "D").End(xlUp).Row - 6
       ReDim arr(1 To lr, 1 To 6)
       For i = LBound(arr, 1) To UBound(arr, 1)
        arr(i, 1) = .Cells(4, "D").Value         ' Fixed Col = Date Form sent
        arr(i, 2) = .Cells(i + 6, "E").Value     ' Name
        arr(i, 3) = .Cells(i + 6, "F").Value     ' Dob
        arr(i, 4) = .Cells(i + 6, "G").Value     ' birthplace
        arr(i, 5) = .Cells(i + 6, "H").Value     ' address
        arr(i, 6) = .Cells(i + 6, "I").Value     ' phone #

     Next i
    End With

    With Worksheets("VolunteerData")
       lr = .Range("A" & .Rows.Count).End(xlUp).Row + 1
       .Cells(lr, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    End With    

  With Worksheets("VolunteerData")
      lr = .Range("G" & .Rows.Count).End(xlUp).Row + 1
      .Cells(lr, "G").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
   End With

   With Worksheets("VolunteerForm")
      lr = .Cells(21, "D").End(xlUp).Row - 15
      ReDim arr(1 To lr, 1 To 6)
     For i = LBound(arr, 1) To UBound(arr, 1)
        arr(i, 1) = .Cells(i + 15, "J").Value
        arr(i, 2) = .Cells(i + 15, "K").Value
        arr(i, 3) = .Cells(i + 15, "L").Value
        arr(i, 4) = .Cells(i + 15, "M").Value
        arr(i, 5) = .Cells(i + 15, "N").Value

       Next i
    End With

  End Sub

谢谢！

Answer 1

您应该使用userform / excel数据输入表或Access数据库。

但是，假设您的表单始终具有相同的行数，并且在顶部和底部表中的排序相同，则可以使用以下方式：

Option Explicit
Public Sub TransferData()

    Dim lastRow As Long, nextRow As Long, dateFilled As Range
    Dim wsDest As Worksheet, wsSource As Worksheet
    Dim formData1 As Range, formData2 As Range

    Set wsDest = ThisWorkbook.Worksheets("VolunteerData")
    Set wsSource = ThisWorkbook.Worksheets("VolunteerForm")
    Set dateFilled = wsSource.Range("D4")
    Set formData1 = wsSource.Range("D7:I11")
    Set formData2 = wsSource.Range("E16:I20")
    Application.ScreenUpdating = False

    With wsDest
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    nextRow = lastRow + 1

    With formData1
        wsDest.Range("A" & nextRow).Resize(.Rows.Count, 1).Value = dateFilled.Value
        wsDest.Range("B" & nextRow).Resize(.Rows.Count, .Columns.Count).Value = formData1.Value
        wsDest.Range("H" & nextRow).Resize(.Rows.Count, .Columns.Count - 1).Value = formData2.Value
    End With

    ''potential housekeeping tasks to clear form?
    formData1.Clear
    formData2.Clear
    formData2.Offset(, -1).Clear
    dateFilled.Clear

    Application.ScreenUpdating = True
End Sub

如何将多个数组中的数据从Excel表单插入数据库？

1 个答案: