创建excel宏以从表单获取信息并将其附加到列表的底部

Question

我目前正在制作电子表格，以帮助跟踪参加我部门每周会议的人员。我试图通过使用宏从列表/表单中复制值来自动化跟踪过程，我的部门成员将输入与会者的电子邮件和日期。然后将电子邮件和日期加在一起（= a＆amp; b）以生成值，该值将用于标记该个人是否在该特定会议中存在。查看表格/表格的图像

会议结束后会生成一份报告，告诉他们有哪些人参加，以及他们有多长时间接听电话。在我收集此报告并将其粘贴到原始列表的底部之前，但由于列和表长度已更改，这已变得效率低下。我想要做的是从计算选项卡中获取电子表格上的电子邮件，日期和值，并将这些值附加到报告选项卡上列表的底部，而不更改任何先前的信息。查看报告选项卡的图像

将值附加到报表底部后，我有另一个名为会议日期的选项卡。这包含一个公式，通过用“Y”或“N”标记来确定个体是否存在。忘了提到每周参加这些会议的是17个人。最后我想拥有它，以便在会议日期选项卡上不存在计算选项卡上输入的日期时，将日期添加到会议日期选项卡。

我仍然是Excel VB和宏的新手，但确实有一些编程经验。只是不在excel。如果有人可以帮助我，那就太棒了！

Answer 1

这个答案试图让你开始。

如果您在互联网上搜索“Excel VBA教程”，您将获得很多点击量。尝试一些因为它们都不同并选择你最喜欢的那个。完成该教程以获得对Excel的一般感觉。我不相信你会在没有这种普遍感觉的情况下成功找到相关代码。

不要试图描述你的整个问题，因为我怀疑有人会回应。相反，尝试将问题分解为几步，并寻求这些步骤的帮助。

例如，您需要确定会后报告中的行数，以便可以访问该数据。然后，您希望将该数据添加到上一个列表的底部。在这两种情况下，您都需要确定工作表中最后使用的行。 “Excel VBA：如何查找最后一行工作表？”是一个简单的问题，你将能够找到多个答案。我在下面回答了这个问题。

我假设会后报告和您正在创建的列表位于不同的工作簿中。您的宏可能与列表位于同一工作簿中，也可能位于不同的工作簿中。宏可以访问自己的工作簿，任何其他恰好打开的工作簿，或者可以根据需要打开许多其他工作簿。再次“Excel VBA：我如何使用多个工作簿？”应该会导致大量的点击。

我没有尝试过我的任何一个问题。我发现“Excel VBA：”会有所帮助，但您可能需要多次尝试才能找到合适的问题以获得您所寻求的答案。但如果你的问题很小且很精确，你应该总能找到答案。

让我们回到第一个问题。 Excel VBA的一个令人恼火的特性是它们几乎总是有几种方法可以达到类似的效果。创建一个新工作簿，创建一个模块并将下面的代码复制到它。运行宏FindFinal()。

此宏演示了几种查找最后一行和列的方法。每种方法都有问题，我试图说明每种方法如何失败。在这个宏中有很多工作表访问，我相信它会回报研究。它可以帮助您确定哪种方法适合您的每个要求。

Option Explicit
Sub FindFinal()

  Dim Col As Long
  Dim Rng As Range
  Dim Row As Long

  ' Try the various techniques on an empty worksheet
  Debug.Print "***** Empty worksheet"
  Debug.Print ""

  With Worksheets("Sheet1")

    .Cells.EntireRow.Delete

    Set Rng = .UsedRange
    If Rng Is Nothing Then
      Debug.Print "Used range is Nothing"
    Else
      Debug.Print "Top row of used range is: " & Rng.Row
      Debug.Print "Left column row of used range is: " & Rng.Column
      Debug.Print "Number of rows in used range is: " & Rng.Rows.Count
      Debug.Print "Number of columns in used range is: " & Rng.Columns.Count
      Debug.Print "!!! Notice that the worksheet is empty but the user range is not."
    End If

    Debug.Print ""

    Set Rng = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious)
    If Rng Is Nothing Then
      Debug.Print "According to Find the worksheet is empty"
    Else
      Debug.Print "According to Find the last row containing a value is: " & Rng.Row
    End If

    Debug.Print ""
    Set Rng = .Cells.SpecialCells(xlCellTypeLastCell)
    If Rng Is Nothing Then
      Debug.Print "According to SpecialCells the worksheet is empty"
    Else
      Debug.Print "According to SpecialCells the last row is: " & Rng.Row
      Debug.Print "According to SpecialCells the last column is: " & Rng.Column
    End If

    Debug.Print ""
    Row = .Cells(1, 1).End(xlDown).Row
    Debug.Print "Down from A1 goes to: A" & Row
    Row = .Cells(Rows.Count, 1).End(xlUp).Row
    Debug.Print "up from A" & Rows.Count & " goes to: A" & Row
    Col = .Cells(1, 1).End(xlToRight).Column
    Debug.Print "Right from A1 goes to: " & ColNumToCode(Col) & "1"
    Col = .Cells(1, Columns.Count).End(xlToLeft).Column
    Debug.Print "Left from " & Columns.Count & _
                "1 goes to: " & ColNumToCode(Col) & "1"

    ' Add some values and formatting to worksheet

    .Range("A1").Value = "A1"
    .Range("A2").Value = "A2"
    For Row = 5 To 7
      .Cells(Row, "A").Value = "A" & Row
    Next
    For Row = 12 To 15
      .Cells(Row, 1).Value = "A" & Row
    Next

    .Range("B1").Value = "B1"
    .Range("C2").Value = "C2"
    .Range("B16").Value = "B6"
    .Range("C17").Value = "C17"

    .Columns("F").ColumnWidth = 5
    .Cells(18, 4).Interior.Color = RGB(128, 128, 255)
    .Rows(19).RowHeight = 5

    Debug.Print ""
    Debug.Print "***** Non-empty worksheet"
    Debug.Print ""

    Set Rng = .UsedRange
    If Rng Is Nothing Then
      Debug.Print "Used range is Nothing"
    Else
      Debug.Print "Top row of used range is: " & Rng.Row
      Debug.Print "Left column row of used range is: " & Rng.Column
      Debug.Print "Number of rows in used range is: " & Rng.Rows.Count
      Debug.Print "Number of columns in used range is: " & Rng.Columns.Count
      Debug.Print "!!! Notice that row 19 which is empty but has had its height changed is ""used""."
      Debug.Print "!!! Notice that column 5 which is empty but has had its width changed is not ""used""."
      Debug.Print "!!! Notice that column 4 which is empty but contains a coloured cell is ""used""."
    End If

    Debug.Print ""

    Set Rng = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious)
    If Rng Is Nothing Then
      Debug.Print "According to Find the worksheet is empty"
    Else
      Debug.Print "According to Find the last row containing a formula is: " & Rng.Row
    End If
    ' *** Note: search by columns not search by rows ***
    Set Rng = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByColumns, xlPrevious)
    If Rng Is Nothing Then
      Debug.Print "According to Find the worksheet is empty"
    Else
      Debug.Print "According to Find the last column containing a formula is: " & Rng.Column
    End If
    ' *** Note: Find returns a single cell and the nature of the search
    '           affects what it find.  Compare SpecialCells below.

    Debug.Print ""
    Set Rng = .Cells.SpecialCells(xlCellTypeLastCell)
    If Rng Is Nothing Then
      Debug.Print "According to SpecialCells the worksheet is empty"
    Else
      Debug.Print "According to SpecialCells the last row is: " & Rng.Row
      Debug.Print "According to SpecialCells the last column is: " & Rng.Column
    End If

    Debug.Print ""
    Row = 1
    Do While True
      Debug.Print "Down from A" & Row & " goes to: ";
      Row = .Cells(Row, 1).End(xlDown).Row
      Debug.Print "A" & Row
      If Row = Rows.Count Then Exit Do
    Loop

  End With

  With Worksheets("Sheet2")

    .Cells.EntireRow.Delete

  .Range("B2").Value = "B2"
  .Range("C3").Value = "C3"
  .Range("B7").Value = "B7"
  .Range("B7:B8").Merge
  .Range("F3").Value = "F3"
  .Range("F3:G3").Merge

    Debug.Print ""
    Debug.Print "***** Try with merged cells"

    Set Rng = .UsedRange
    If Rng Is Nothing Then
      Debug.Print "Used range is Nothing"
    Else
      Debug.Print "Used range is: " & Replace(Rng.Address, "$", "")
    End If

    Debug.Print ""
    Set Rng = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious)
    If Rng Is Nothing Then
      Debug.Print "According to Find the worksheet is empty"
    Else
      Debug.Print "According to Find the last cell by row is: " & Replace(Rng.Address, "$", "")
    End If
    Set Rng = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByColumns, xlPrevious)
    If Rng Is Nothing Then
      Debug.Print "According to Find the worksheet is empty"
    Else
      Debug.Print "According to Find the last cell by column is: " & Replace(Rng.Address, "$", "")
    End If
      Debug.Print "!!! Notice that Find can ""see"" B7 but not F3."

    Debug.Print ""
    Set Rng = .Cells.SpecialCells(xlCellTypeLastCell)
    If Rng Is Nothing Then
      Debug.Print "According to SpecialCells the worksheet is empty"
    Else
      Debug.Print "According to SpecialCells the last row is: " & Rng.Row
      Debug.Print "According to SpecialCells the last column is: " & Rng.Column
    End If

  End With

End Sub
Function ColNumToCode(ByVal ColNum As Long) As String

  Dim Code As String
  Dim PartNum As Long

  ' Last updated 3 Feb 12.  Adapted to handle three character codes.
  If ColNum = 0 Then
    ColNumToCode = "0"
  Else
    Code = ""
    Do While ColNum > 0
      PartNum = (ColNum - 1) Mod 26
      Code = Chr(65 + PartNum) & Code
      ColNum = (ColNum - PartNum - 1) \ 26
    Loop
  End If

End Function

在上面的代码中，我直接使用.Range("B2").Value = "B2"等语句访问工作表单元格。当您将数据从一个工作表移动到另一个工作表时，这可能会很慢。另一种方法是使用数组。

Dim Rng As Range
Dim ShtValues as Variant

With Worksheets("Xxxx")
  Set Rng = .Range(.Cells(Row1, Col1), .Cells(Row2, Col2))
End With 

ShtValues = Rng.Value

Variant是一个可以包含数组的变量。 ShtValues = Rng.Value将ShtValues转换为二维数组，保留Rng中的所有值。在工作表中访问数组时，处理数组的速度要快得多。

.Range(.Cells(Row1, Col1), .Cells(Row2, Col2))可能是创建指定工作表区域的范围的最简单方法，其中单元格（Row1，Col1）为左上角单元格，单元格（Row2，Col2）为右下角。

如果我理解正确，您希望将会议后报告中的数据移动到列表中，但报告和列表中的列序列不同。这表明您需要将数据作为列移动。使用.Range(.Cells(Row1, Col1), .Cells(Row2, Col2))和Col1 = Col2，您可以定义一个列的范围。

Rng1.Copy Destination := Cell2

上述语句将Rng1的内容复制到从Cell2开始的范围。对于报告中的每列数据，这样的语句可能是复制数据的最简单方法。

我希望上面给你一个开始。