Dim a() as String,b() as String,c() as long
Dim d() as string
dim tmpS as String
a = Split(Text1.Text)
redim c(lbound(a) to ubound(a)) as long
redim d(lbound(a) to ubound(a)) as string
for i=lbound(a) to ubound(a)
tmpS = lcase(a(i))
a(i) = ""
d(i)=tmps
for j = 1 to Len(tmpS)
a(i)=a(i) & Format(Asc(Mid(tmpS,j,1)),"000")
next j
c(i)=Val(a(i))
Next i
Redim B(2) as string
For i=Lbound(a) to ubound(a)
For j=1 to Ubound(B)-1
If a(j)>a(j+1) and a(j)<a(j-1) then b(j)=d(i):exit for
Next j
Next i
'現在B數組就是按字典序的句子排列,把以上代碼寫在什麽地方，B數組的輸出問題自己處理
2、輸入若幹個學生的成績，統計平均成績、最好成績、最差成績、以及各成績分數段的人數。
幾百年前寫的代碼，沒想到真的有人要，控件的問題自己看著辦吧！懶得動態生成了~
要點：Text2.MultiLine = True
我說妳八成不會記得加
Dim PtsArr() As Integer
Dim AppPath As String
Private Sub Command1_Click()
Dim pAver As Double, pW(4) As Integer
Dim pctW(4) As Single
Dim TotPeo As Integer
ReDim Preserve PtsArr(UBound(PtsArr) - 1) As Integer
pAver = Format(GetAverage(PtsArr), ".00")
GetPiece PtsArr, pW(1), pW(2), pW(3), pW(4), pW(0)
TotPeo = UBound(PtsArr) - LBound(PtsArr) + 1
For i = 0 To 4
pctW(i) = Format(pW(i) / TotPeo * 100, ".0")
Next i
Dim Bg As Integer, Lg As Integer
GetBL PtsArr, Bg, Lg
Text2.Text = "總人數 " & TotPeo & " 平均分 " & pAver & vbCrLf
Text2.Text = Text2.Text & "最高分 " & Bg & " 最低分 " & Lg & vbCrLf
Text2.Text = Text2.Text & "及格人數 " & pW(0) & " 及格率 " & pctW(0) & "%" & vbCrLf
Text2.Text = Text2.Text & "49分以下 " & pW(1) & " 比率 " & pctW(1) & "%" & vbCrLf
Text2.Text = Text2.Text & "50-59分 " & pW(2) & " 比率 " & pctW(2) & "%" & vbCrLf
Text2.Text = Text2.Text & "60-89分 " & pW(3) & " 比率 " & pctW(3) & "%" & vbCrLf
Text2.Text = Text2.Text & "90分以上 " & pW(4) & " 比率 " & pctW(4) & "%"
End Sub
Private Sub Command2_Click()
Shell "notepad """ & AppPath & "ReadMe.txt""", vbNormalFocus
End Sub
Private Sub Command3_Click()
If Text2.Text <> "" Then
Open AppPath & "OutLog.txt" For Append As #1
Print #1,
Print #1, Text2.Text
Close #1
MsgBox "已將成績追加到" & AppPath & "OutLog.txt末端！", vbInformation
Else
MsgBox "請錄入成績！", vbExclamation
End If
End Sub
Private Sub Command4_Click()
On Error GoTo ErrHand
Dim str As String
For i = LBound(PtsArr) To UBound(PtsArr) - 1
str = str & CStr(PtsArr(i)) & vbCrLf
Next i
MsgBox str, vbDefaultButton1, "成績檢查"
Exit Sub
ErrHand:
Debug.Print Err.Number & " " & Err.Description
MsgBox "輸入數據有誤！", vbExclamation
End Sub
Private Sub Command5_Click()
For i = LBound(PtsArr) To UBound(PtsArr)
PtsArr(i) = 0
Next i
End Sub
Private Sub Command6_Click()
Dim DelData As Integer
DelData = Val(InputBox("請輸入要刪除的數據！", "成績處理軟件"))
DeleteData PtsArr, DelData
End Sub
Private Sub Form_Load()
ReDim PtsArr(0) As Integer
AppPath = App.Path
If Right(AppPath, 1) <> "\" Then AppPath = AppPath & "\"
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
Dim WorkPts As Long
Text2.Text = ""
If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) And KeyAscii <> 8 And KeyAscii <> 13 Then KeyAscii = 0
If KeyAscii = 13 Then
WorkPts = Val(Text1.Text)
If WorkPts > 100 Or WorkPts < 0 Or Text1.Text = "" Then MsgBox "輸入有誤！", vbExclamation: Exit Sub
PtsArr(UBound(PtsArr)) = WorkPts
ReDim Preserve PtsArr(UBound(PtsArr) + 1) As Integer
Text1.Text = ""
End If
End Sub
Function GetAverage(PArr() As Integer) As Double
Dim sum As Long
For i = LBound(PArr) To UBound(PArr)
sum = sum + PArr(i)
Next i
GetAverage = sum / (UBound(PArr) - LBound(PArr) + 1)
End Function
Sub GetPiece(PArr() As Integer, ByRef p49 As Integer, ByRef p5059 As Integer, ByRef p6089 As Integer, ByRef p90 As Integer, ByRef pAllow As Integer)
p49 = 0: p5059 = 0: p6089 = 0: p90 = 0: pAllow = 0
For i = LBound(PArr) To UBound(PArr)
Select Case PArr(i)
Case 0 To 49: p49 = p49 + 1
Case 50 To 59: p5059 = p5059 + 1
Case 60 To 89: p6089 = p6089 + 1
Case 90 To 100: p90 = p90 + 1
End Select
If PArr(i) >= 60 Then pAllow = pAllow + 1
Next i
End Sub
Sub DeleteData(PArr() As Integer, KillData As Integer)
For i = LBound(PArr) To UBound(PArr)
If Val(PArr(i)) = KillData Then
For j = i To UBound(PArr) - 1
PArr(j) = PArr(j + 1)
Next j
ReDim Preserve PArr(LBound(PArr) To (UBound(PArr) - 1)) As Integer
Exit For
End If
Next i
End Sub
Sub GetBL(PArr() As Integer, ByRef Biggest As Integer, ByRef Lowest As Integer)
Dim Bg As Integer, Lg As Integer
Lg = PArr(LBound(PArr))
For i = LBound(PArr) To UBound(PArr)
If PArr(i) > Bg Then Bg = PArr(i)
If PArr(i) < Lg Then Lg = PArr(i)
Next i
Biggest = Bg: Lowest = Lg
End Sub