Как вставить данные из нескольких массивов из формы Excel в базу данных?

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

Вы должны использовать форму ввода данных пользовательской формы / Excel или Access Database.

Однако, если ваша форма всегда имеет одинаковое количество строк и имеет одинаковый порядок в верхней и нижней таблицах, вы можете использовать что-то вроде:

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