简体   繁体   中英

VBA Spelling Test

The aim of the following is to automate a spelling test process. Each word in the test has an attached word list of between 1 and 11 eleven words that students need to practise if they are unable to spell the word correctly.

The VBA below currently generates a list of words for an individual specified in cell C2 however I would like the VBA to generate a list of words for all available individuals. I am thinking that I will need a 'For... Each' loop but I'm not quite sure how to implement.

Ideally, I would like words to be outputted to a worksheet which contains the following info:

  • A summary at the top which outlines students who have completed the test and the number of words they have been allocated. The summary also highlights students who have less than 10 words need to complete the next test immediately and students who have more than 10 but less than 50, need to complete the next test in the near future.

  • A section for individual students who have more than zero words which specifies: first name, surname, number of words and date. Words should appear in a grid which is 12 columns wide and the necessary number of rows high.

     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 

I agree with D Mason, it is impossible to deduce exactly what you want from your specification. You supply a lot of detail but much detail needed by a programmer is missing. It would be difficult to get the missing parts of your design via an exchange of comments so I have decided to guess what you seek. If you study my specification and use F8 to single step through my code you should be able to discover how I achieve particular effects. You can then use your enhanced VBA knowledge to write the macros you want.

I am guessing that most of your existing code was created using the Macro Recorder. This is a good way of learning the syntax of an unfamiliar statement but is not a good way of learning VBA. The Recorder does not know your intentions so records each action as it happens. The result is syntactically correct VBA but not good VBA. By studying my macros you will enhance your understanding of VBA but you must spend some time on a systematic study.

Search the web for “Excel VBA Tutorial” and you will find many. Try a few and pick one that matches your learning style. A local college may offer short courses that cover the basics. I prefer books. I visited a large library and spent half-an-hour looking through their VBA Primers. I borrowed the three I liked most to try out at home. I then bought my favourite. I have it on my shelf and I still refer to it from time to time; good investment. The time you spend learning VBA will quickly repay it.

I deduce from your code that columns A to O of worksheet “Dashboard” contain your word lists. Perhaps column A contains a list number but no matter. Columns P, Q and so on are for individual students and contain “N” if that student has not yet mastered that row's list. Currently rows 4 to 34 contain word lists but no doubt you will add more later. This is my Dashboard:

工作表仪表板的初始内容

I have filled the word list area with formulaic data because that helps with testing the code. I do not know how you use rows 1 to 3 and have left them blank.

I have created a new worksheet “Students” which I initialised to:

工作表学生的初始内容

I envisage columns C, D and so on being used for other student information but I have only used a “Name” and a “To do” column. I will explain the “To do” column later.

I ran macro AddNewStudent() . Worksheets “Dashboard” and “Students” changed as shown below. At the bottom of worksheets “Dashboard”, you can see the worksheets that have been created. I also show worksheet “George”.

更新的工作表仪表板

更新的工作表学生

乔治工作表的初始内容

If a new student joins your class, add their name to worksheets “Students” and rerun AddNewStudent() .

Macro OutputWordLists() outputs the word lists for each student. You do not say but I assume you manually remove Ns from worksheet “Dashboard” as students demonstrate their mastery of the various word lists. From time to time you will rerun OutputWorklists() to update the statistics in worksheet “Students” and to produce new word lists for your students which you could print and distribute if appropriate.

I have updated worksheet “Dashboard” to reflect the students' progress and I have just run AddNewStudent() to create a worksheet for new student Frederick. I have also added some more word lists at the bottom.

工作表仪表板已准备好用于OutputWordLists

I ran OutputWordLists() . This has no effect on worksheet “Dashboard”. Worksheet “Students” has been updated to record the current number of Ns in the “To do” column. You express an interest in other statistics but I do not understand what you want. I hope I have given you enough techniques to allow you to decide how to add the code to calculate these statistics. Worksheet “George” has been updated for the next 10 word lists that he has to master. I have only included 10 word lists because I thought listing the lot would be too intimidating.

由宏OutputWordLists更新的工作表学生

工作表乔治由宏OutputWordLists更新

As I said at the beginning, you should single step through my macros and study what they do. Come back with questions if necessary but the more you can discover on your own, the faster you will develop your VBA skills. I hope this gives you enough ideas to progress.

I should perhaps mention that these macros are development macros and include Debug.Print and Debug.Assert statements. I would never include such statements in a production macro that I was distributing to others but they are invaluable aids during development.

Good luck and welcome to the joys of programming.

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

If my answer to your question was helpful, you should accept the answer and move on. Questioners who come back for another bite are called vampireson Meta Stack Overflow. There are several reasons why you should accept and move on:

  • Accepting an answer is the site appropriate way of saying “thank you”.
  • The answerer may not know anything about the subject of the supplementary question which will be lost.
  • One of the objectives of Stack Overflow is to build a resource that programmers can mine at will for questions & answers relevant to their current need. The more topics covered in a single question, the less likely someone who is interested in one of those topics will find it. My answer may have helped you but how likely is it that: (1) someone else has a similar need and (2) if they did that they would find my answer under the title “VBA Spelling test”.

I probably should have voted to close your question as too broad. However, I like to get those new to programming started and to prove that their requirement can be met with VBA macros. I learnt my first programming language at university in 1965. I have maintained that skill (albeit with new languages) because at home and at work there have been many tasks that are easy to perform with the aid of a program but hard without. In my opinion you are absolutely right when you say: “as an early-career teacher, I can see a huge range of uses for it.”

I am not a great fan of VBA. Excel has some extraordinarily useful functions but the language is limited. I learnt it because it was the only way of creating programs at work.

I am not sure I would be helping you develop if I wrote another macro for you. I certainly would not be helping Stack Overflow achieve its objective by linking another macro to this question.

You give an overview of your current objectives. I have not studied Spelling.xlsm in enough detail to know what would be the next step. I do not have the time to match the current state of your macros against your objective so as to identify the next step. You need to do that.

Having identified the next step, do you know enough to code it? If not, sum up the next step in a few words. With Stack Overflow, search for “[excel-vba] xxxxxxx” which means search for questions with tag excel-vba and topic xxxxxxx. Look through the results for relevant code. If necessary, revise xxxxxxx; it might take a few goes to home in on the right question. Although I think Stack Overflow is the best, there are other technique forums. Try goggling for “xxxxxxx” or “Excel VBA: xxxxxxx”.

If you pick up some ideas, write the smallest macro you can that will prove you have understood how to perform that step. If you are unable to get that macro working, post it here with a statement of what it does and what you want it to do. Questions like that will small blocks of code and a clear statement of what is going wrong are often answered in minutes. I might be the person who answers that question although probably not because I normally only look at questions unanswered after 24 hours.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM