我的用户表单基于其他单元格的活动单元更新

Question

我刚刚开始通过观看YouTube视频来学习VBA，并尝试创建自己的用户表单。

我很难将列D添加到第J列并在列K显示SUM，然后计算百分比并在列L上显示它并在列M上显示加权百分比。

示例：

Column (HPP)highest possible point 70

D   E   F   G   H   I   J
10  8   9   10  12  7   8

Column  K   (sum of column D-J) = 54
Column  L   (HPP divided by raw score) = 77.14%
Column  M   (column L *0.30) = 23.14%

我需要的是能够将这些数据反映在我的用户表单上，这样我就不用每次都需要查看百分比得到我的工作表。

还可以添加D列，F列和J列，并在P列中反映出我的用户表格中的答案吗？

以下是我的用户表单上的代码。

Dim currentrow As Long


Private Sub UserForm_Click()

End Sub

Private Sub UserForm_Initialize()

'POPULATES ENTRY FIELDS

currentrow = 5

txtGRDcode.Text = Cells(currentrow, 1).Text

txtFname.Text = Cells(currentrow, 2).Text

txtLname.Text = Cells(currentrow, 3).Text

txtQuiz1.Text = Cells(currentrow, 4).Text

txtQuiz2.Text = Cells(currentrow, 5).Text

txtQuiz3.Text = Cells(currentrow, 6).Text

txtQuiz4.Text = Cells(currentrow, 7).Text

txtQuiz5.Text = Cells(currentrow, 8).Text

txtQuiz6.Text = Cells(currentrow, 9).Text

txtLongt1.Text = Cells(currentrow, 10).Text

txtWWtotal.Text = Cells(currentrow, 11).Text

txtWWps.Text = Cells(currentrow, 12).Text

txtWWws.Text = Cells(currentrow, 13).Text

txtPF1.Text = Cells(currentrow, 14).Text

txtPF2.Text = Cells(currentrow, 15).Text

txtPF3.Text = Cells(currentrow, 16).Text

txtPF4.Text = Cells(currentrow, 17).Text

txtPF5.Text = Cells(currentrow, 18).Text

txtPF6.Text = Cells(currentrow, 19).Text

txtPF7.Text = Cells(currentrow, 20).Text

txtPTtotal.Text = Cells(currentrow, 21).Text

txtPTps.Text = Cells(currentrow, 22).Text

txtPTws.Text = Cells(currentrow, 23).Text

txtQrtAss.Text = Cells(currentrow, 24).Text

txtQrtAssPS.Text = Cells(currentrow, 25).Text

txtQrtAssWS.Text = Cells(currentrow, 26).Text

txtInitialGrade.Text = Cells(currentrow, 27).Text

txtFinal.Text = Cells(currentrow, 28).Text

End Sub

Private Sub cmdAdd_Click()

'ADD DATA TO CELLS


Dim lastrow As Long

lastrow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

Cells(lastrow + 1, "A").Value = txtGRDcode.Text

Cells(lastrow + 1, "B").Value = txtFname.Text

Cells(lastrow + 1, "C").Value = txtLname.Text

Cells(lastrow + 1, "D").Value = txtQuiz1.Text

Cells(lastrow + 1, "E").Value = txtQuiz2.Text

Cells(lastrow + 1, "F").Value = txtQuiz3.Text

Cells(lastrow + 1, "G").Value = txtQuiz4.Text

Cells(lastrow + 1, "H").Value = txtQuiz5.Text

Cells(lastrow + 1, "I").Value = txtQuiz6.Text

Cells(lastrow + 1, "J").Value = txtLongt1.Text

Cells(lastrow + 1, "N").Value = txtPF1.Text

Cells(lastrow + 1, "O").Value = txtPF2.Text

Cells(lastrow + 1, "P").Value = txtPF3.Text

Cells(lastrow + 1, "Q").Value = txtPF4.Text

Cells(lastrow + 1, "R").Value = txtPF5.Text

Cells(lastrow + 1, "S").Value = txtPF6.Text

Cells(lastrow + 1, "T").Value = txtPF7.Text


Cells(lastrow + 1, "X").Value = txtQrtAss.Text


End Sub

Private Sub cmdClear_Click()

'REFRESH ENTRY FIELDS

txtGRDcode.Text = ""

txtFname.Text = ""

txtLname.Text = ""

txtQuiz1.Text = ""

txtQuiz2.Text = ""

txtQuiz3.Text = ""

txtQuiz4.Text = ""

txtQuiz5.Text = ""

txtQuiz6.Text = ""

txtLongt1.Text = ""

txtWWtotal.Text = ""

txtWWps.Text = ""

txtWWws.Text = ""

txtPF1.Text = ""

txtPF2.Text = ""

txtPF3.Text = ""

txtPF4.Text = ""

txtPF5.Text = ""

txtPF6.Text = ""

txtPF7.Text = ""

txtPTtotal.Text = ""

txtPTps.Text = ""

txtPTws.Text = ""

txtQrtAss.Text = ""

txtQrtAssPS.Text = ""

txtQrtAssWS.Text = ""

txtInitialGrade = ""

txtFinal = ""

End Sub

Private Sub cmdDelete_Click()

Dim lastrow

Dim myfname As String

lastrow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

myfname = txtFname.Text

For currentrow = 2 To lastrow

If Cells(currentrow, 1).Text = myfname Then


Cells(currentrow, 1).EntireRow.Delete


End If

Next currentrow

txtFname.SetFocus

End Sub



Private Sub cmdNext_Click()

lastrow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

currentrow = currentrow + 1

If currentrow = lastrow + 1 Then

MsgBox ("You have reached the last row of data!")

currentrow = lastrow

End If

txtGRDcode.Text = Cells(currentrow, 1).Text

txtFname.Text = Cells(currentrow, 2).Text

txtLname.Text = Cells(currentrow, 3).Text

txtQuiz1.Text = Cells(currentrow, 4).Text

txtQuiz2.Text = Cells(currentrow, 5).Text

txtQuiz3.Text = Cells(currentrow, 6).Text

txtQuiz4.Text = Cells(currentrow, 7).Text

txtQuiz5.Text = Cells(currentrow, 8).Text

txtQuiz6.Text = Cells(currentrow, 9).Text

txtLongt1.Text = Cells(currentrow, 10).Text

txtWWtotal.Text = Cells(currentrow, 11).Text

txtWWps.Text = Cells(currentrow, 12).Text

txtWWws.Text = Cells(currentrow, 13).Text

txtPF1.Text = Cells(currentrow, 14).Text

txtPF2.Text = Cells(currentrow, 15).Text

txtPF3.Text = Cells(currentrow, 16).Text

txtPF4.Text = Cells(currentrow, 17).Text

txtPF5.Text = Cells(currentrow, 18).Text

txtPF6.Text = Cells(currentrow, 19).Text

txtPF7.Text = Cells(currentrow, 20).Text

txtPTtotal.Text = Cells(currentrow, 21).Text

txtPTps.Text = Cells(currentrow, 22).Text

txtPTws.Text = Cells(currentrow, 23).Text

txtQrtAss.Text = Cells(currentrow, 24).Text

txtQrtAssPS.Text = Cells(currentrow, 25).Text

txtQrtAssWS.Text = Cells(currentrow, 26).Text

txtInitialGrade.Text = Cells(currentrow, 27).Text

txtFinal.Text = Cells(currentrow, 28).Text



End Sub

Private Sub cmdPrevious_Click()

currentrow = currentrow - 1

If currentrow > 1 Then

txtGRDcode.Text = Cells(currentrow, 1).Text

txtFname.Text = Cells(currentrow, 2).Text

txtLname.Text = Cells(currentrow, 3).Text

txtQuiz1.Text = Cells(currentrow, 4).Text

txtQuiz2.Text = Cells(currentrow, 5).Text

txtQuiz3.Text = Cells(currentrow, 6).Text

txtQuiz4.Text = Cells(currentrow, 7).Text

txtQuiz5.Text = Cells(currentrow, 8).Text

txtQuiz6.Text = Cells(currentrow, 9).Text

txtLongt1.Text = Cells(currentrow, 10).Text

txtWWtotal.Text = Cells(currentrow, 11).Text

txtWWps.Text = Cells(currentrow, 12).Text

txtWWws.Text = Cells(currentrow, 13).Text

txtPF1.Text = Cells(currentrow, 14).Text

txtPF2.Text = Cells(currentrow, 15).Text

txtPF3.Text = Cells(currentrow, 16).Text

txtPF4.Text = Cells(currentrow, 17).Text

txtPF5.Text = Cells(currentrow, 18).Text

txtPF6.Text = Cells(currentrow, 19).Text

txtPF7.Text = Cells(currentrow, 20).Text

txtPTtotal.Text = Cells(currentrow, 21).Text

txtPTps.Text = Cells(currentrow, 22).Text

txtPTws.Text = Cells(currentrow, 23).Text

txtQrtAss.Text = Cells(currentrow, 24).Text

txtQrtAssPS.Text = Cells(currentrow, 25).Text

txtQrtAssWS.Text = Cells(currentrow, 26).Text

txtInitialGrade.Text = Cells(currentrow, 27).Text

txtFinal.Text = Cells(currentrow, 28).Text

ElseIf currentrow = 1 Then

MsgBox "Now you are in the header row!"

currentrow = currentrow + 1

End If

End Sub

Private Sub cmdQuit_Click()

Unload UserForm1

End Sub

Private Sub cmdUpdate_Click()

Dim fname As String, lname As String, grdcode As String


grdcode = txtGRDcode.Text

Cells(currentrow, 1).Value = grdcode

fname = txtFname.Text

Cells(currentrow, 2).Value = fname

lname = txtLname.Text

Cells(currentrow, 3).Value = lname

Quiz1 = txtQuiz1.Text

Cells(currentrow, 4).Value = Quiz1

quiz2 = txtQuiz2.Text

Cells(currentrow, 5).Value = quiz2

quiz3 = txtQuiz3.Text

Cells(currentrow, 6).Value = quiz3

quiz4 = txtQuiz4.Text

Cells(currentrow, 7).Value = quiz4

quiz5 = txtQuiz5.Text

Cells(currentrow, 8).Value = quiz5

quiz6 = txtQuiz6.Text

Cells(currentrow, 9).Value = quiz6

Longt1 = txtLongt1.Text

Cells(currentrow, 10).Value = Longt1


PF1 = txtPF1.Text

Cells(currentrow, 14).Value = PF1

PF2 = txtPF2.Text

Cells(currentrow, 15).Value = PF2

PF3 = txtPF3.Text

Cells(currentrow, 16).Value = PF3

pf4 = txtPF4.Text

Cells(currentrow, 17).Value = pf4

pf5 = txtPF5.Text

Cells(currentrow, 18).Value = pf5

pf6 = txtPF6.Text

Cells(currentrow, 19).Value = pf6

pf7 = txtPF7.Text

Cells(currentrow, 20).Value = pf7


qrtass = txtQrtAss.Text

Cells(currentrow, 24).Value = qrtass


End Sub