UserForm 填写电子表格

【问题标题】：UserForm to fill a spreadsheetUserForm 填写电子表格
【发布时间】：2019-03-20 03:06:35
【问题描述】：

我目前有一个编码，可以让一个人完成用户表单 - 选择提交并将信息输入电子表格（相同的工作簿）。

我遇到的问题是墓碑信息，例如名字、姓氏、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

【问题讨论】：

  • 一张图抵得上一千字:)
  • @ScottHoltzman - 不知道怎么给你发这张照片。您想要一张我运行编码后电子表格的图片吗？
  • 用您的数据设置图片更新您的问题，并可能是您想要发生的事情和当前发生的事情的示例。
  • 我很乐意为你做这件事，但我不知道如何附加图片或粘贴我在网页中设置的数据的视觉效果
  • 查看如何添加图片（记得编辑你的问题）meta.stackoverflow.com/questions/344851/…

标签： vba userform


【解决方案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 倍。

EDIT - 未经测试但应该可以工作

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

【讨论】：

  • @Tim .....谢谢你，但你让我不知所措。您刚刚发布的编码允许我做什么，它在我目前的编码中取代了什么？
  • 它有效，但我以前的编码（上面未显示）会搜索重复项，如果是这样，它将删除旧信息并替换为新信息，你能告诉我如何修改我的编码，以便它再次这样做 - '搜索重复 Set r = ws.Range("C:C").Find(Me.TxtPRI.Value, LookIn:=xlValues, lookat:=xlWhole) If Not r Is Nothing Then MsgBox "You国家转移清单中已有记录。之前的记录将被删除，并在其位置输入新数据" iRow = r.Row End If
  • 如果您有新要求，请将其作为新问题发布。
猜你喜欢
  • 1970-01-01
  • 1970-01-01
  • 2021-04-29
  • 1970-01-01
  • 1970-01-01
  • 2011-11-08
  • 1970-01-01
  • 1970-01-01
  • 2017-05-18
相关资源
最近更新 更多
热门标签
Java Python linux javascript Mysql C# Docker 算法 前端 SpringBoot Redis Vue spring 设计模式 .net core .net kubernetes c++ 数据库 数据结构 大数据 js 机器学习 微服务 Android Go 程序员 面试 JVM ASP.net core 云原生 人工智能 后端 PHP git CSS golang k8s Nginx Django mybatis 深度学习 多线程 React 架构 devops 爬虫 云计算 Spring Boot LeetCode