Пользовательская форма для заполнения электронной таблицы

Question

В настоящее время у меня есть код, который позволит человеку заполнить пользовательскую форму - выберите «Отправить», и информация будет передана в электронную таблицу (та же рабочая книга).

проблема, с которой я столкнулся, заключается в том, что информация о надгробной плите, такая как имя, фамилия, идентификатор, язык и адрес электронной почты. и т. д. .... заполняется один раз в пользовательской форме, но человек может выбрать несколько провинций и городов (до 10 вариантов)

John/ Smith/ 12568/ Bilingual/ John.Smith@gmail.com
New Brunswick/ Moncton
Quebec/ Montreal
Nova Scotia/ Halifax

Мне нужна информация о надгробной плите для заполнения каждой строки в целях поиска, но если человек выбирает только провинцию, то я не хочу, чтобы она прекратила заполняться.

текущая кодировка, которую я заполняю, но автоматически занимает 10 строк в электронной таблице независимо от того, есть ли информация, если ячейки

кодирование довольно длинное, так как это был единственный способ, которым я знал, как это сделать

 With ws
       .Unprotect Password:="Transfer19"
       .Cells(iRow, 1).Value = Me.TxtFirst.Value

      If Me.ListProv2.Value = "" Then
      .Cells(iRow + 1, 1).Value = ""
      Else
      .Cells(iRow + 1, 1).Value = Me.TxtFirst.Value
      End If

      If Me.ListProv3.Value = "" Then
      .Cells(iRow + 2, 1).Value = ""
      Else
      .Cells(iRow + 2, 1).Value = Me.TxtFirst.Value
      End If

      If Me.ListProv4.Value = "" Then
      .Cells(iRow + 3, 1).Value = ""
      Else
      .Cells(iRow + 3, 1).Value = Me.TxtFirst.Value
      End If

      If Me.ListProv5.Value = "" Then
      .Cells(iRow + 4, 1).Value = ""
      Else
      .Cells(iRow + 4, 1).Value = Me.TxtFirst.Value
      End If

      If Me.ListProv6.Value = "" Then
      .Cells(iRow + 5, 1).Value = ""
      Else
      .Cells(iRow + 5, 1).Value = Me.TxtFirst.Value
      End If

      If Me.ListProv7.Value = "" Then
      .Cells(iRow + 6, 1).Value = ""
      Else
      .Cells(iRow + 6, 1).Value = Me.TxtFirst.Value
      End If

      If Me.ListProv8.Value = "" Then
      .Cells(iRow + 7, 1).Value = ""
      Else
      .Cells(iRow + 7, 1).Value = Me.TxtFirst.Value
      End If

      If Me.ListProv9.Value = "" Then
      .Cells(iRow + 8, 1).Value = ""
      Else
      .Cells(iRow + 8, 1).Value = Me.TxtFirst.Value
      End If

      If Me.ListProv10.Value = "" Then
      .Cells(iRow + 9, 1).Value = ""
      Else
      .Cells(iRow + 9, 1).Value = Me.TxtFirst.Value
      End If


      .Cells(iRow, 2).Value = Me.TxtLast.Value
      If Me.ListProv2.Value = "" Then
      .Cells(iRow + 1, 2).Value = ""
      Else
      .Cells(iRow + 1, 2).Value = Me.TxtLast.Value
      End If

      If Me.ListProv3.Value = "" Then
      .Cells(iRow + 2, 2).Value = ""
      Else
      .Cells(iRow + 2, 2).Value = Me.TxtLast.Value
      End If

      If Me.ListProv4.Value = "" Then
      .Cells(iRow + 3, 2).Value = ""
      Else
      .Cells(iRow + 3, 2).Value = Me.TxtLast.Value
      End If

      If Me.ListProv5.Value = "" Then
      .Cells(iRow + 4, 2).Value = ""
      Else
      .Cells(iRow + 4, 2).Value = Me.TxtLast.Value
      End If

      If Me.ListProv6.Value = "" Then
      .Cells(iRow + 5, 2).Value = ""
      Else
      .Cells(iRow + 5, 2).Value = Me.TxtLast.Value
      End If

      If Me.ListProv7.Value = "" Then
      .Cells(iRow + 6, 2).Value = ""
      Else
      .Cells(iRow + 6, 2).Value = Me.TxtLast.Value
      End If

 If Me.ListProv8.Value = "" Then
 .Cells(iRow + 7, 2).Value = ""
 Else
 .Cells(iRow + 7, 2).Value = Me.TxtLast.Value
 End If

 If Me.ListProv9.Value = "" Then
 .Cells(iRow + 8, 2).Value = ""
 Else
 .Cells(iRow + 8, 2).Value = Me.TxtLast.Value
 End If

 If Me.ListProv10.Value = "" Then
 .Cells(iRow + 9, 2).Value = ""
 Else
 .Cells(iRow + 9, 2).Value = Me.TxtLast.Value
 End If

 .Cells(iRow, 3).Value = Me.TxtPRI.Value

 If Me.ListProv2.Value = "" Then
 .Cells(iRow + 1, 3).Value = ""
 Else
 .Cells(iRow + 1, 3).Value = Me.TxtPRI.Value
 End If

 If Me.ListProv3.Value = "" Then
 .Cells(iRow + 2, 3).Value = ""
 Else
 .Cells(iRow + 2, 3).Value = Me.TxtPRI.Value
 End If

 If Me.ListProv4.Value = "" Then
 .Cells(iRow + 3, 3).Value = ""
 Else
 .Cells(iRow + 3, 3).Value = Me.TxtPRI.Value
 End If

 If Me.ListProv5.Value = "" Then
 .Cells(iRow + 4, 3).Value = ""
 Else
 .Cells(iRow + 4, 3).Value = Me.TxtPRI.Value
 End If

 If Me.ListProv6.Value = "" Then
 .Cells(iRow + 5, 3).Value = ""
 Else
 .Cells(iRow + 5, 3).Value = Me.TxtPRI.Value
 End If

 If Me.ListProv7.Value = "" Then
 .Cells(iRow + 6, 3).Value = ""
 Else
 .Cells(iRow + 6, 3).Value = Me.TxtPRI.Value
 End If

 If Me.ListProv8.Value = "" Then
 .Cells(iRow + 7, 3).Value = ""
 Else
 .Cells(iRow + 7, 3).Value = Me.TxtPRI.Value
 End If

 If Me.ListProv9.Value = "" Then
 .Cells(iRow + 8, 3).Value = ""
 Else
 .Cells(iRow + 8, 3).Value = Me.TxtPRI.Value
 End If

 If Me.ListProv10.Value = "" Then
 .Cells(iRow + 9, 3).Value = ""
 Else
 .Cells(iRow + 9, 3).Value = Me.TxtPRI.Value
 End If

  'Copy Group
 .Cells(iRow, 4).Value = Me.TxtGR.Value
 If Me.ListProv2.Value = "" Then
 .Cells(iRow + 1, 4).Value = ""
 Else
 .Cells(iRow + 1, 4).Value = Me.TxtGR.Value
 End If

 If Me.ListProv3.Value = "" Then
 .Cells(iRow + 2, 4).Value = ""
 Else
 .Cells(iRow + 2, 4).Value = Me.TxtGR.Value
 End If

 If Me.ListProv4.Value = "" Then
 .Cells(iRow + 3, 4).Value = ""
 Else
 .Cells(iRow + 3, 4).Value = Me.TxtGR.Value
 End If

 If Me.ListProv5.Value = "" Then
 .Cells(iRow + 4, 4).Value = ""
 Else
 .Cells(iRow + 4, 4).Value = Me.TxtGR.Value
 End If

 If Me.ListProv6.Value = "" Then
 .Cells(iRow + 5, 4).Value = ""
 Else
 .Cells(iRow + 5, 4).Value = Me.TxtGR.Value
 End If

 If Me.ListProv7.Value = "" Then
 .Cells(iRow + 6, 4).Value = ""
 Else
 .Cells(iRow + 6, 4).Value = Me.TxtGR.Value
 End If

 If Me.ListProv8.Value = "" Then
 .Cells(iRow + 7, 4).Value = ""
 Else
 .Cells(iRow + 7, 4).Value = Me.TxtGR.Value
 End If

 If Me.ListProv9.Value = "" Then
 .Cells(iRow + 8, 4).Value = ""
 Else
 .Cells(iRow + 8, 4).Value = Me.TxtGR.Value
 End If

 If Me.ListProv10.Value = "" Then
 .Cells(iRow + 9, 4).Value = ""
 Else
 .Cells(iRow + 9, 4).Value = Me.TxtGR.Value
 End If

   ' copy Level
 .Cells(iRow, 5).Value = Me.TxtLV.Value
 If Me.ListProv2.Value = "" Then
 .Cells(iRow + 1, 5).Value = ""
 Else
 .Cells(iRow + 1, 5).Value = Me.TxtLV.Value
 End If

 If Me.ListProv3.Value = "" Then
 .Cells(iRow + 2, 5).Value = ""
 Else
 .Cells(iRow + 2, 5).Value = Me.TxtLV.Value
 End If

 If Me.ListProv4.Value = "" Then
 .Cells(iRow + 3, 5).Value = ""
 Else
   .Cells(iRow + 3, 5).Value = Me.TxtLV.Value
   End If

   If Me.ListProv5.Value = "" Then
   .Cells(iRow + 4, 5).Value = ""
   Else
   .Cells(iRow + 4, 5).Value = Me.TxtLV.Value
   End If

   If Me.ListProv6.Value = "" Then
   .Cells(iRow + 5, 5).Value = ""
   Else
   .Cells(iRow + 5, 5).Value = Me.TxtLV.Value
   End If

   If Me.ListProv7.Value = "" Then
   .Cells(iRow + 6, 5).Value = ""
   Else
   .Cells(iRow + 6, 5).Value = Me.TxtLV.Value
   End If

   If Me.ListProv8.Value = "" Then
   .Cells(iRow + 7, 5).Value = ""
   Else
   .Cells(iRow + 7, 5).Value = Me.TxtLV.Value
   End If

   If Me.ListProv9.Value = "" Then
   .Cells(iRow + 8, 5).Value = ""
   Else
   .Cells(iRow + 8, 5).Value = Me.TxtLV.Value
   End If

   If Me.ListProv10.Value = "" Then
   .Cells(iRow + 9, 5).Value = ""
   Else
   .Cells(iRow + 9, 5).Value = Me.TxtLV.Value
   End If

   ' Copy linguistic
   .Cells(iRow, 6).Value = Me.TxtLinguistic.Value
   If Me.ListProv2.Value = "" Then
   .Cells(iRow + 1, 6).Value = ""
   Else
   .Cells(iRow + 1, 6).Value = Me.TxtLinguistic.Value
   End If

   If Me.ListProv3.Value = "" Then
   .Cells(iRow + 2, 6).Value = ""
   Else
   .Cells(iRow + 2, 6).Value = Me.TxtLinguistic.Value
   End If

   If Me.ListProv4.Value = "" Then
   .Cells(iRow + 3, 6).Value = ""
   Else
   .Cells(iRow + 3, 6).Value = Me.TxtLinguistic.Value
   End If

   If Me.ListProv5.Value = "" Then
   .Cells(iRow + 4, 6).Value = ""
   Else
   .Cells(iRow + 4, 6).Value = Me.TxtLinguistic.Value
   End If

   If Me.ListProv6.Value = "" Then
   .Cells(iRow + 5, 6).Value = ""
   Else
   .Cells(iRow + 5, 6).Value = Me.TxtLinguistic.Value
   End If

   If Me.ListProv7.Value = "" Then
   .Cells(iRow + 6, 6).Value = ""
   Else
   .Cells(iRow + 6, 6).Value = Me.TxtLinguistic.Value
   End If

   If Me.ListProv8.Value = "" Then
   .Cells(iRow + 7, 6).Value = ""
   Else
   .Cells(iRow + 7, 6).Value = Me.TxtLinguistic.Value
   End If

   If Me.ListProv9.Value = "" Then
   .Cells(iRow + 8, 6).Value = ""
   Else
   .Cells(iRow + 8, 6).Value = Me.TxtLinguistic.Value
   End If

   If Me.ListProv10.Value = "" Then
   .Cells(iRow + 9, 6).Value = ""
   Else
   .Cells(iRow + 9, 6).Value = Me.TxtLinguistic.Value
   End If

   ' Copy Email
   .Cells(iRow, 7).Value = Me.TxtEmail.Value
   If Me.ListProv2.Value = "" Then
   .Cells(iRow + 1, 7).Value = ""
   Else
   .Cells(iRow + 1, 7).Value = Me.TxtEmail.Value
   End If

   If Me.ListProv3.Value = "" Then
   .Cells(iRow + 2, 7).Value = ""
   Else
   .Cells(iRow + 2, 7).Value = Me.TxtEmail.Value
   End If

   If Me.ListProv4.Value = "" Then
   .Cells(iRow + 3, 7).Value = ""
   Else
   .Cells(iRow + 3, 7).Value = Me.TxtEmail.Value
   End If

   If Me.ListProv5.Value = "" Then
   .Cells(iRow + 4, 7).Value = ""
   Else
   .Cells(iRow + 4, 7).Value = Me.TxtEmail.Value
   End If

   If Me.ListProv6.Value = "" Then
   .Cells(iRow + 5, 7).Value = ""
   Else
   .Cells(iRow + 5, 7).Value = Me.TxtEmail.Value
   End If

   If Me.ListProv7.Value = "" Then
   .Cells(iRow + 6, 7).Value = ""
   Else
   .Cells(iRow + 6, 7).Value = Me.TxtEmail.Value
   End If

   If Me.ListProv8.Value = "" Then
   .Cells(iRow + 7, 7).Value = ""
   Else
   .Cells(iRow + 7, 7).Value = Me.TxtEmail.Value
   End If

   If Me.ListProv9.Value = "" Then
   .Cells(iRow + 8, 7).Value = ""
   Else
   .Cells(iRow + 8, 7).Value = Me.TxtEmail.Value
   End If

   If Me.ListProv10.Value = "" Then
   .Cells(iRow + 9, 7).Value = ""
   Else
   .Cells(iRow + 9, 7).Value = Me.TxtEmail.Value
   End If

   ' Copy Resume Number
   .Cells(iRow, 8).Value = Me.TxtResumeNum.Value
   If Me.ListProv2.Value = "" Then
   .Cells(iRow + 1, 8).Value = ""
   Else
   .Cells(iRow + 1, 8).Value = Me.TxtResumeNum.Value
   End If

   If Me.ListProv3.Value = "" Then
   .Cells(iRow + 2, 8).Value = ""
   Else
   .Cells(iRow + 2, 8).Value = Me.TxtResumeNum.Value
   End If

   If Me.ListProv4.Value = "" Then
   .Cells(iRow + 3, 8).Value = ""
   Else
   .Cells(iRow + 3, 8).Value = Me.TxtResumeNum.Value
   End If

   If Me.ListProv5.Value = "" Then
   .Cells(iRow + 4, 8).Value = ""
   Else
   .Cells(iRow + 4, 8).Value = Me.TxtResumeNum.Value
   End If

   If Me.ListProv6.Value = "" Then
   .Cells(iRow + 5, 8).Value = ""
   Else
   .Cells(iRow + 5, 8).Value = Me.TxtResumeNum.Value
   End If

   If Me.ListProv7.Value = "" Then
   .Cells(iRow + 6, 8).Value = ""
   Else
   .Cells(iRow + 6, 8).Value = Me.TxtResumeNum.Value
   End If

   If Me.ListProv8.Value = "" Then
   .Cells(iRow + 7, 8).Value = ""
   Else
   .Cells(iRow + 7, 8).Value = Me.TxtResumeNum.Value
   End If

   If Me.ListProv9.Value = "" Then
   .Cells(iRow + 8, 8).Value = ""
   Else
   .Cells(iRow + 8, 8).Value = Me.TxtResumeNum.Value
   End If

   If Me.ListProv10.Value = "" Then
   .Cells(iRow + 9, 8).Value = ""
   Else
   .Cells(iRow + 9, 8).Value = Me.TxtResumeNum.Value
   End If

   ' Copy Reason
   .Cells(iRow, 9).Value = Me.TxtReason.Value
   If Me.ListProv2.Value = "" Then
   .Cells(iRow + 1, 9).Value = ""
   Else
   .Cells(iRow + 1, 9).Value = Me.TxtReason.Value
   End If

   If Me.ListProv3.Value = "" Then
   .Cells(iRow + 2, 9).Value = ""
   Else
   .Cells(iRow + 2, 9).Value = Me.TxtReason.Value
   End If

   If Me.ListProv4.Value = "" Then
   .Cells(iRow + 3, 9).Value = ""
   Else
   .Cells(iRow + 3, 9).Value = Me.TxtReason.Value
   End If

   If Me.ListProv5.Value = "" Then
   .Cells(iRow + 4, 9).Value = ""
   Else
   .Cells(iRow + 4, 9).Value = Me.TxtReason.Value
   End If

   If Me.ListProv6.Value = "" Then
   .Cells(iRow + 5, 9).Value = ""
   Else
   .Cells(iRow + 5, 9).Value = Me.TxtReason.Value
   End If

   If Me.ListProv7.Value = "" Then
   .Cells(iRow + 6, 9).Value = ""
   Else
   .Cells(iRow + 6, 9).Value = Me.TxtReason.Value
   End If

   If Me.ListProv8.Value = "" Then
   .Cells(iRow + 7, 9).Value = ""
   Else
   .Cells(iRow + 7, 9).Value = Me.TxtReason.Value
   End If

   If Me.ListProv9.Value = "" Then
   .Cells(iRow + 8, 9).Value = ""
   Else
   .Cells(iRow + 8, 9).Value = Me.TxtReason.Value
   End If

   If Me.ListProv10.Value = "" Then
   .Cells(iRow + 9, 9).Value = ""
   Else
   .Cells(iRow + 9, 9).Value = Me.TxtReason.Value
   End If

   ' Copy Registration Date
   .Cells(iRow, 10).Value = Me.TxtDate.Value
   If Me.ListProv2.Value = "" Then
   .Cells(iRow + 1, 10).Value = ""
   Else
   .Cells(iRow + 1, 10).Value = Me.TxtDate.Value
   End If

   If Me.ListProv3.Value = "" Then
   .Cells(iRow + 2, 10).Value = ""
   Else
   .Cells(iRow + 2, 10).Value = Me.TxtDate.Value
   End If

   If Me.ListProv4.Value = "" Then
   .Cells(iRow + 3, 10).Value = ""
   Else
   .Cells(iRow + 3, 10).Value = Me.TxtDate.Value
   End If

   If Me.ListProv5.Value = "" Then
   .Cells(iRow + 4, 10).Value = ""
   Else
   .Cells(iRow + 4, 10).Value = Me.TxtDate.Value
   End If

   If Me.ListProv6.Value = "" Then
   .Cells(iRow + 5, 10).Value = ""
   Else
   .Cells(iRow + 5, 10).Value = Me.TxtDate.Value
   End If

   If Me.ListProv7.Value = "" Then
   .Cells(iRow + 6, 10).Value = ""
   Else
   .Cells(iRow + 6, 10).Value = Me.TxtDate.Value
   End If

   If Me.ListProv8.Value = "" Then
   .Cells(iRow + 7, 10).Value = ""
   Else
   .Cells(iRow + 7, 10).Value = Me.TxtDate.Value
   End If

   If Me.ListProv9.Value = "" Then
   .Cells(iRow + 8, 10).Value = ""
   Else
   .Cells(iRow + 8, 10).Value = Me.TxtDate.Value
   End If

   If Me.ListProv10.Value = "" Then
   .Cells(iRow + 9, 10).Value = ""
   Else
   .Cells(iRow + 9, 10).Value = Me.TxtDate.Value
   End If

   .Cells(iRow, 11).Value = Me.ListProv1.Value
   .Cells(iRow, 12).Value = Me.ListCity1.Value
   .Cells(iRow + 1, 11).Value = Me.ListProv2.Value
   .Cells(iRow + 1, 12).Value = Me.ListCity2.Value
   .Cells(iRow + 2, 11).Value = Me.ListProv3.Value
   .Cells(iRow + 2, 12).Value = Me.ListCity3.Value
   .Cells(iRow + 3, 11).Value = Me.ListProv4.Value
   .Cells(iRow + 3, 12).Value = Me.ListCity4.Value
   .Cells(iRow + 4, 11).Value = Me.ListProv5.Value
   .Cells(iRow + 4, 12).Value = Me.ListCity5.Value
   .Cells(iRow + 5, 11).Value = Me.ListProv6.Value
   .Cells(iRow + 5, 12).Value = Me.ListCity6.Value
   .Cells(iRow + 6, 11).Value = Me.ListProv7.Value
   .Cells(iRow + 6, 12).Value = Me.ListCity7.Value
   .Cells(iRow + 7, 11).Value = Me.ListProv8.Value
   .Cells(iRow + 7, 12).Value = Me.ListCity8.Value
   .Cells(iRow + 8, 11).Value = Me.ListProv9.Value
   .Cells(iRow + 8, 12).Value = Me.ListCity9.Value
   .Cells(iRow + 9, 11).Value = Me.ListProv10.Value
   .Cells(iRow + 9, 12).Value = Me.ListCity10.Value
   .Protect Password:="Transfer19"

  End With

Answer 1

У вас есть тонна кода, которую можно вырезать, как только вы поймете, что можете обращаться к элементам управления в форме в цикле, используя их имена, чтобы получить их значение

Dim n, p, c

For n = 1 to 10
    p = Me.Controls("ListProv" & n).Value
    c = Me.Controls("ListCity" & n).Value
Next n

Как только выПосле этого все необходимые вам изменения будут в 10 раз проще.

РЕДАКТИРОВАТЬ - не проверено, но должно работать

Dim info, rw As Range, n As Long

With ws
    'get all the tombstone info into an array
    info = Array(Me.TxtFirst.Value, Me.TxtLast.Value, _
                Me.TxtPRI.Value, Me.TxtGR.Value, _
                Me.TxtLV.Value, Me.TxtLinguistic.Value, _
                Me.TxtEmail.Value, Me.TxtResumeNum.Value, _
                Me.TxtReason.Value, Me.TxtDate.Value)

    .Unprotect Password:="Transfer19"

    'get the first empty row...
    Set rw = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow

    'loop over the province and city controls
    For n = 1 To 10
         'get province and city values
         p = Me.Controls("ListProv" & n).Value
         c = Me.Controls("ListCity" & n).Value

        If n = 1 Or p <> "" Then                   '<<if on first loop, or province has been selected
            rw.Cells(1).Resize(1, 10).Value = info '<< populate all common info
            rw.Cells(11).Value = p
            rw.Cells(12).Value = c
            Set rw = rw.Offset(1, 0) 'move down one row
        End If
    Next n

    .Protect Password:="Transfer19"

End With