Question

以下目标是自动化拼写测试过程。测试中的每个单词都附有1到11个单词的附加单词列表，如果学生无法正确拼写单词，则需要练习这些单词。

下面的VBA当前为单元格C2中指定的个人生成单词列表但是我希望VBA为所有可用的个人生成单词列表。我在想，我需要一个＆＃39; For ... Each＆＃39;循环，但我不太确定如何实施。

理想情况下，我希望将单词输出到包含以下信息的工作表：

顶部的摘要概述了完成测试的学生以及他们分配的单词数量。摘要还强调，少于10个单词的学生需要立即完成下一个考试，而那些年龄超过10个但不到50个的学生需要在不久的将来完成下一个考试。

一个单词学生的部分，其单词超过零，指定：名字，姓氏，单词数和日期。单词应出现在12列宽且必要行数高的网格中。

Sub GenerateSpellingWords()

Dim nameColumnNumber As Integer
Dim namePerson As String
Dim WS As Worksheet

nameColumnNumber = Sheets("Dashboard").Range("I2").Value
namePerson = Sheets("Dashboard").Range("C2").Value

 Sheets.Add.Name = namePerson
 Range("A1:L1").Select
 Selection.Merge
 With Selection
 .HorizontalAlignment = xlCenter
 .VerticalAlignment = xlCenter
End With
ActiveCell.FormulaR1C1 = namePerson & "'s Spelling Words"
Rows("1:1").RowHeight = 27.75
Range("A1:L1").Select
Selection.Font.Bold = True
With Selection.Font
.Size = 14
End With

Sheets("Dashboard").Select
Rows("4:34").Select
Selection.AutoFilter
Sheets("Dashboard").Range("$A$4:$W$34").AutoFilter Field:=nameColumnNumber,  Criteria1:="N"
Sheets("Dashboard").Range("C5:N34").Select
Selection.Copy
Sheets(namePerson).Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Replace What:="0", Replacement:="'", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Range("A2").Select
Sheets("Dashboard").Select
Range("C2").Select
Selection.AutoFilter
End Sub

Answer 1

我同意D Mason的说法，不可能从你的规范中精确推断出你想要的东西。您提供了大量细节，但缺少程序员所需的详细信息。通过交换意见很难得到你设计中缺失的部分，所以我决定猜猜你在寻找什么。如果您研究我的规范并使用F8单步执行我的代码，您应该能够发现我是如何实现特定效果的。然后，您可以使用增强的VBA知识编写所需的宏。

我猜大多数现有代码都是使用Macro Recorder创建的。这是学习不熟悉语句的语法的好方法，但不是学习VBA的好方法。记录器不知道您的意图，因此记录每个动作。结果是语法正确的VBA但不是很好的VBA。通过研究我的宏，你将增强你对VBA的理解，但你必须花一些时间进行系统研究。

在网上搜索“Excel VBA教程”，你会发现很多。尝试一下，选择一个符合你学习风格的。当地的大学可能会提供涵盖基础知识的短期课程。我更喜欢书。我参观了一个大型图书馆，花了半个小时来查看他们的VBA入门。我借了我最喜欢的三个在家尝试。然后我买了我最喜欢的。我把它放在架子上，我仍然不时地提到它;好的投资。你花在学习VBA上的时间很快就会得到回报。

我从您的代码中推断出工作表“Dashboard”的A到O列包含您的单词列表。也许列A包含列表编号，但无论如何。 P，Q等列适用于个别学生，如果该学生尚未掌握该行列表，则包含“N”。目前第4行至第34行包含单词列表，但毫无疑问，您稍后会添加更多单词列表这是我的仪表板：

Initial contents of worksheet Dashboard

我在单词列表区域填充了公式数据，因为这有助于测试代码。我不知道你如何使用第1行到第3行并将它们留空。

我创建了一个新的工作表“学生”，我初始化为：

Initial contents of worksheet Students

我设想将C，D等列用于其他学生信息，但我只使用了“名称”和“待办事项”列。我稍后会解释“待办事项”一栏。

我运行了宏 AddNewStudent（）。工作表“仪表板”和“学生”已更改，如下所示。在工作表“仪表板”的底部，您可以看到已创建的工作表。我还会显示工作表“乔治”。

Updated worksheet Dashboard

Updated worksheet Student

Initial contents of Worksheet George

如果新学生加入您的班级，请将他们的名字添加到工作表“学生”中，然后重新运行 AddNewStudent（）。

宏 OutputWordLists（）输出每个学生的单词列表。您没有说，但我假设您手动从工作表“仪表板”中删除Ns，因为学生展示了他们对各种单词列表的掌握。您将不时重新运行 OutputWorklists（）以更新工作表“学生”中的统计信息，并为您的学生生成新的单词列表，您可以根据需要进行打印和分发。

我已更新工作表“Dashboard”以反映学生的进度，我刚刚运行 AddNewStudent（）为新学生Frederick创建工作表。我还在底部添加了一些单词列表。

Worksheet Dashboard ready for OutputWordLists

我运行了 OutputWordLists（）。这对工作表“仪表板”没有影响。工作表“学生”已更新，以记录“待办事项”列中的当前N数。您表示对其他统计数据感兴趣，但我不明白您想要什么。我希望我已经给你足够的技巧，让你决定如何添加代码来计算这些统计数据。工作表“乔治”已经更新为他必须掌握的下10个单词列表。我只包含了10个单词列表，因为我认为列出该批次会太令人生畏。

Worksheet Students as updated by macro OutputWordLists

Worksheet George as updated by macro OutputWordLists

正如我在开始时所说的那样，你应该单步执行我的宏并研究它们的作用。如有必要，请回答问题，但是您可以自己发现的越多，您开发VBA技能的速度就越快。我希望这能为你提供足够的进步。

我或许应该提到这些宏是开发宏，包括Debug.Print和Debug.Assert语句。我永远不会在我分发给其他人的生产宏中包含这样的陈述，但它们在开发过程中是非常宝贵的辅助工具。

祝你好运，欢迎来到编程的乐趣。

Option Explicit

  ' Use data type "Long" rather than "Integer". "Integer" specifies a 16-bit
  ' number which requires special processing on a 32-bit computer.

  ' Using constants makes the code easier to understand and easier to maintain.
  Const ColDshBrdFirstName As Long = 16
  Const ColStdLstName As Long = 1
  Const ColStdLstToDo As Long = 2
  Const RowDshBrdFirstWordList As Long = 4
Sub AddNewStudent()

  Dim ColDshBrdCrnt As Long
  Dim Found As Boolean
  Dim InxWsht As Long
  Dim Rng As Range
  Dim RowDshBrdLast As Long
  Dim RowStdLstCrnt As Long
  Dim StudentName As String

  ' Speeds up the macro and stops the screen flashing as new worksheets are created
  Application.ScreenUpdating = False

  ' Identify the last row containing a word list
  With Worksheets("Dashboard")
    Set Rng = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious)
    If Rng Is Nothing Then
      ' No data found
      Debug.Assert False
      Exit Sub
    Else
      RowDshBrdLast = Rng.Row
      Debug.Print "Last word list on row " & RowDshBrdLast
    End If
  End With

  RowStdLstCrnt = 2       ' Assume one header row

  Do While True

    ' Extract new name for student list
    StudentName = Worksheets("Students").Cells(RowStdLstCrnt, ColStdLstName).Value
    If StudentName = "" Then
      ' Name list exhausted
      Exit Do
    End If

    ' Look for existing worksheet for this student
    Found = False
    For InxWsht = 1 To Worksheets.Count
      If Worksheets(InxWsht).Name = StudentName Then
        ' Worksheet for this student found
        Found = True
        Exit For
      End If
    Next

    If Not Found Then
      ' New student

      ' Create a new worksheet for this student

      ' Add new worksheet after all existing worlsheets
      Worksheets.Add After:=Worksheets(Worksheets.Count)
      ' The new worksheet is now the active worksheet
      ActiveSheet.Name = StudentName

      ' Note 1: I do not select anything because Select is a slow command.
      ' Note 2: Once I have merged range A1:L1, I write to cell A1. Cells
      '         B1 to L1 effectively no longer exist.

      Range("A1:L1").Merge
      With Range("A1")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Value = StudentName & "'s Spelling Words"
        .RowHeight = 27.75
        With .Font
          .Bold = True
          .Size = 14
        End With
      End With

      With Worksheets("Dashboard")

        ' Find an empty column for this student and initialise it.
        If .Cells(RowDshBrdFirstWordList - 1, ColDshBrdFirstName).Value = "" Then
          ' This is the first student
          ColDshBrdCrnt = ColDshBrdFirstName
        ElseIf .Cells(RowDshBrdFirstWordList - 1, ColDshBrdFirstName + 1).Value = "" Then
          ' This is the second student
          ColDshBrdCrnt = ColDshBrdFirstName + 1
        Else
          ' Find the first unused column
          ' .End(xlToRight) is the VBA equivalent of clicking Ctrl+RightArrow.
          ' Experiment with Ctrl+RightArrow to discover why I test the first and second
          ' columns before using .End(xlToRight).
          ColDshBrdCrnt = .Cells(RowDshBrdFirstWordList - 1, _
                                 ColDshBrdFirstName).End(xlToRight).Column + 1
        End If

        ' Add name as title and fill column with Ns
        .Cells(RowDshBrdFirstWordList - 1, ColDshBrdCrnt).Value = StudentName
        .Range(.Cells(RowDshBrdFirstWordList, ColDshBrdCrnt), _
               .Cells(RowDshBrdLast, ColDshBrdCrnt)).Value = "N"
      End With

      With Worksheets("Students")

        ' Record number of Ns in ToDo column
        .Cells(RowStdLstCrnt, ColStdLstToDo).Value = _
                                     RowDshBrdLast - RowDshBrdFirstWordList + 1
      End With

    End If  ' Not Found

    RowStdLstCrnt = RowStdLstCrnt + 1

  Loop  ' until student list exhaused

  Worksheets("Dashboard").Activate

End Sub
Sub OutputWordLists()

  Dim ColDshBrdCrnt As Long
  Dim ColDshBrdLast As Long
  Dim Found As Boolean
  Dim InxRng As Long
  Dim InxWsht As Long
  Dim numToDo As Long
  Dim Rng As Range
  Dim RngCopy As Range
  Dim RngDshBrdCrnt As Range
  Dim RowDshBrdLast As Long
  Dim RowStdLstCrnt As Long
  Dim StudentName As String

  ' Find the last row and column of "Dashboard"
  With Worksheets("Dashboard")
    ColDshBrdLast = .Cells(RowDshBrdFirstWordList - 1, Columns.Count).End(xlToLeft).Column
    Set Rng = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious)
    If Rng Is Nothing Then
      ' No data found
      Debug.Assert False
      Exit Sub
    Else
      RowDshBrdLast = Rng.Row
    End If
  End With

  Debug.Print "Last student column " & ColDshBrdLast
  Debug.Print "Last word list on row " & RowDshBrdLast

  ' Loop for each student column
  For ColDshBrdCrnt = ColDshBrdFirstName To ColDshBrdLast

    ' Get Student name and number of word list to do
    With Worksheets("Dashboard")
      StudentName = .Cells(RowDshBrdFirstWordList - 1, ColDshBrdCrnt).Value
      Set Rng = .Range(.Cells(RowDshBrdFirstWordList, ColDshBrdCrnt), _
                       .Cells(RowDshBrdLast, ColDshBrdCrnt))
      numToDo = Application.WorksheetFunction.CountIf(Rng, "N")
    End With

    Debug.Print StudentName & " has " & numToDo & " word lists to do"

    ' Locate row for this student in "Students"
    With Worksheets("Students")
      Set Rng = .Columns(1).Find(StudentName, .Range("A1"), xlFormulas, , xlByRows, xlPrevious)
      If Rng Is Nothing Then
        ' Student not found
        Debug.Assert False
        Exit Sub
      Else
        RowStdLstCrnt = Rng.Row
      End If
      .Cells(RowStdLstCrnt, ColStdLstToDo).Value = numToDo
    End With

    With Worksheets("Dashboard")

      ' Locate all rows not done by this student
      If .AutoFilterMode Then
        ' AutoFilter is on so turn off in case wrong filter selected
        .Cells.AutoFilter
      End If
      .Cells.AutoFilter Field:=ColDshBrdCrnt, Criteria1:="N"
      Set Rng = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)
      .Cells.AutoFilter     ' Switch off

      Debug.Print StudentName & " " & Rng.Address
      Set Rng = Rng.EntireRow
      Debug.Print StudentName & " " & Rng.Address

      ' Ensure a maximum of 10 rows have been selected for copying.
      ' Discard any header rows
      Set RngCopy = Nothing
      InxRng = 0
      For Each RngDshBrdCrnt In Rng
        If RngDshBrdCrnt.Row < RowDshBrdFirstWordList Then
          ' Ignore this header row
        Else
          If RngCopy Is Nothing Then
            ' First row
            Set RngCopy = RngDshBrdCrnt
          Else
            ' Subsequent row
            Set RngCopy = Union(RngCopy, RngDshBrdCrnt)
          End If
          InxRng = InxRng + 1
          If InxRng = 10 Then Exit For
        End If
      Next RngDshBrdCrnt

      Debug.Print StudentName & " " & RngCopy.Address

      ' Reduce copy range to word lists.  That is, exclude student columns
      Set RngCopy = Intersect(RngCopy, .Range(.Columns(1), .Columns(ColDshBrdFirstName - 1)))

      Debug.Print StudentName & " " & RngCopy.Address

    End With

    ' Locate worksheet for this student
    Found = False
    For InxWsht = 1 To Worksheets.Count
      If Worksheets(InxWsht).Name = StudentName Then
        ' Worksheet for this student found
        Found = True
        Exit For
      End If
    Next

    If Not Found Then
      ' No worksheet for this student
      Debug.Assert False
      Exit Sub
    End If

    With Worksheets(InxWsht)
      ' Clear any existing contents except for title row
      .Range(.Rows(2), .Rows(Rows.Count)).EntireRow.Delete
      ' Copy word lists across
      RngCopy.Copy Destination:=.Range("A3")
    End With

  Next ColDshBrdCrnt

End Sub

Answer 2

如果我对你的问题的答案有帮助，你应该接受答案并继续前进。回来再次讨厌的提问者被称为vampireson Meta Stack Overflow。您应该接受并继续前进有几个原因：

接受答案是网站说“谢谢”的恰当方式。
回答者可能对补充质询的主题一无所知。
Stack Overflow的目标之一是构建一个程序员可以随意挖掘问题和资源的资源。与当前需求相关的答案。单个问题涵盖的主题越多，对这些主题之一感兴趣的人就越不可能找到它。我的回答可能对你有所帮助，但有多大可能：（1）其他人有类似的需要;（2）如果他们这样做，他们会在“VBA拼写测试”标题下找到答案。

我可能应该投票将你的问题视为过于宽泛。但是，我喜欢让那些刚接触编程的人开始并证明他们的要求可以通过VBA宏来满足。我在1965年在大学学习了我的第一门编程语言。我保持了这种技能（尽管使用了新的语言），因为在家里和工作中有许多任务很容易通过一个程序来执行，但很难没有。在我看来，当你说：“作为一名早期职业教师，我可以看到它有很多用途。”

我不是VBA的忠实粉丝。 Excel有一些非常有用的功能，但语言有限。我学到了它，因为它是在工作中创建程序的唯一方法。

如果我为你写了另一个宏，我不确定我会帮助你发展。我当然不会通过将另一个宏链接到这个问题来帮助Stack Overflow实现其目标。

您概述了当前的目标。我没有足够详细地研究Spelling.xlsm以了解下一步将会是什么。我没有时间将宏的当前状态与您的目标相匹配，以便确定下一步。你需要这样做。

确定了下一步后，您是否足够了解它？如果没有，请用几句话总结下一步。使用Stack Overflow，搜索“[excel-vba] xxxxxxx”，这意味着搜索带有标签excel-vba和主题xxxxxxx的问题。查看相关代码的结果。如有必要，修改xxxxxxx;在正确的问题上可能需要一些回家。虽然我认为Stack Overflow是最好的，但还有其他技术论坛。尝试为“xxxxxxx”或“Excel VBA：xxxxxxx”进行goggling。

如果您选择了一些想法，请编写可以证明您已了解如何执行该步骤的最小宏。如果您无法使该宏工作，请在此处发布，并说明它的作用以及您希望它做什么。像这样的问题可以在几分钟内回答小块代码和明确错误的陈述。我可能是回答这个问题的人，虽然可能不是因为我通常只会查看24小时后未回答的问题。

VBA拼写测试

2 个答案: