Question

我目前有一个编码，可以让人们填写UserForm-选择“提交”，并将信息输入到电子表格（相同的工作簿）中。

我遇到的问题是墓碑信息，例如名字，姓氏，ID，语言和电子邮件地址。等等。。。在用户表单中一次完成，但此人可以选择多个省市（最多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

填写电子表格的用户表格

1 个答案: