谁来把我这个词表分析一下,给100分(要程序)

Question

Private Sub Command1_Click()
    Dim Str As String
    Dim arrTmp() As String
    Dim StringArray1() As String
    Dim StringArray2() As String
    Dim StringArray3() As String
    Dim P1 As Integer
    Dim P2 As Integer
    Dim i As Integer
    
    Str = "$abnormal[9b'n0:m2l]a.不正常的；变态的$aboard[2'b0:d]adv.上船(飞机、车)$abolish[2'b0li6]vt.废除，取消$about[2'baut]prep.关于；在…周围$above[2'b3v]prep.在…上面；高于$abroad[2'br0:d]ad.(在)国外；"
    
    If Left(Str, 1) = "$" Then
        Str = Mid(Str, 2)
    End If
    
    arrTmp = Split(Str, "$")
    
    ReDim StringArray1(UBound(arrTmp)) As String
    ReDim StringArray2(UBound(arrTmp)) As String
    ReDim StringArray3(UBound(arrTmp)) As String
    
    For i = 0 To UBound(arrTmp)
        P1 = InStr(1, arrTmp(i), "[")
        P2 = InStr(1, arrTmp(i), "]")
        StringArray1(i) = Left(arrTmp(i), P1 - 1)
        StringArray2(i) = Mid(arrTmp(i), P1, P2 - P1 + 1)
        StringArray3(i) = Mid(arrTmp(i), P2 + 1)
    Next i
    
    For i = 0 To UBound(arrTmp)
        Debug.Print StringArray1(i), StringArray2(i), StringArray3(i)
    Next i
End Sub

Answer 1

Private StringArray1() As String
Private StringArray2() As String
Private StringArray3() As String
    
    
Private Sub Form_Load()
    Dim Str As String
    Dim arrTmp() As String
    Dim P1 As Integer
    Dim P2 As Integer
    Dim i As Integer
    
    Str = "$abnormal[9b'n0:m2l]a.不正常的；变态的$aboard[2'b0:d]adv.上船(飞机、车)$abolish[2'b0li6]vt.废除，取消$about[2'baut]prep.关于；在…周围$above[2'b3v]prep.在…上面；高于$abroad[2'br0:d]ad.(在)国外；"
    
    If Left(Str, 1) = "$" Then
        Str = Mid(Str, 2)
    End If
    
    arrTmp = Split(Str, "$")
    
    ReDim StringArray1(UBound(arrTmp)) As String
    ReDim StringArray2(UBound(arrTmp)) As String
    ReDim StringArray3(UBound(arrTmp)) As String
    
    For i = 0 To UBound(arrTmp)
        P1 = InStr(1, arrTmp(i), "[")
        P2 = InStr(1, arrTmp(i), "]")
        StringArray1(i) = Left(arrTmp(i), P1 - 1)
        StringArray2(i) = Mid(arrTmp(i), P1, P2 - P1 + 1)
        StringArray3(i) = Mid(arrTmp(i), P2 + 1)
    Next i
    
    For i = 0 To UBound(arrTmp)
        Debug.Print StringArray1(i), StringArray2(i), StringArray3(i)
    Next i
End Sub
Private Sub Command1_Click()
    Dim strFind As String
    Dim intFind As Integer
        
    strFind = "about"
    intFind = Find(strFind)
    
    If intFind = -1 Then
        MsgBox "找不到单词！", vbExclamation, "提示"
    Else
        MsgBox "单词: " & strFind & vbCrLf & _
               "单标: " & StringArray2(intFind) & vbCrLf & _
               "词义: " & StringArray3(intFind), vbExclamation, "提示"
    End If
End Sub
'折半查找，如果找到了，返回一个顺序号，否则返回-1
Private Function Find(strFindKey As String) As Integer
    Dim intLow As Integer
    Dim intMid As Integer
    Dim intHigh As Integer
    
    intLow = 0
    intHigh = UBound(StringArray1)
    
    Do While intLow <= intHigh
        intMid = (intLow + intHigh) / 2
        If strFindKey = StringArray1(intMid) Then
            Find = intMid
            Exit Function
        ElseIf strFindKey < StringArray1(intMid) Then
            intHigh = intMid - 1
        ElseIf strFindKey > StringArray1(intMid) Then
            intLow = intMid + 1
        End If
    Loop
    Find = -1
End Function

Answer 2

it is very easy if you use RegExp object, for example:dim stringarray1(), stringarray2(), stringarray3()
dim str, re,matches, match, istr = "$abnormal[9b'n0:m2l]a.不正常的；变态的$aboard[2'b0:d]adv.上船(飞机、车)$abolish[2'b0li6]vt.废除，取消$about[2'baut]prep.关于；在…周围$above[2'b3v]prep.在…上面；高于$abroad[2'br0:d]ad.(在)国外；到处"set re = new RegExp
re.global = true
re.pattern = "\$(\w+)\[([^\]]+)\]([^\$]+)"
set matches = re.execute (str)redim stringarray1(matches.count-1)
redim stringarray2(matches.count-1)
redim stringarray3(matches.count-1)msgbox matches.counti=0for each match in matches
  stringarray1(i) = match.submatches(0)
  stringarray2(i) = match.submatches(1)
  stringarray3(i) = match.submatches(2)
  i=i+1
nextmsgbox join(stringarray1,chr(13) & chr(10))
msgbox join(stringarray2,chr(13) & chr(10))
msgbox join(stringarray3,chr(13) & chr(10))

Answer 3

junwhj() ------谢谢关注!!!
    我那个字符串是从.TXT文件中读取的你可以参照如下:SourceFile = App.Path & "\band4.txt" 'Source file
'''      X = 0 'Set subscript/word counter to 0
'''    Open SourceFile For Input As #1 'Open source file
'''        Do Until EOF(1) 'Loop until end of file
'''       
'''            Input #1, temp 'Read from file into array
'''      ...... 加入你的分析过程.............            
'''        ReDim Preserve sStringArray1(X)
'''         sStringArray1(X) =            ReDim Preserve sStringArray2(X)
'''         sStringArray2(X) = '''         ReDim Preserve sStringArray3(X)
'''         sStringArray3(X) = 
'''        X = X + 1 'Icrement subscript
'''            'End If
'''        Loop
'''    Close #1 'Close file
    X = X - 1
按照这种办法把程序改一下,我给200分.谢谢!!!!!!谢谢!!!!!!并说明用了什么(label,command,text)等!!!!!!

Answer 4

'================================================
'把以下内容复制到记事本，再保存为"Form1.frm"
'================================================
VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   1365
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4980
   LinkTopic       =   "Form1"
   ScaleHeight     =   1365
   ScaleWidth      =   4980
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "关闭"
      Height          =   315
      Left            =   3600
      TabIndex        =   2
      Top             =   720
      Width           =   1095
   End
   Begin VB.TextBox Text1 
      Height          =   300
      Left            =   240
      TabIndex        =   1
      Top             =   600
      Width           =   3015
   End
   Begin VB.CommandButton Command1 
      Caption         =   "查找"
      Default         =   -1  'True
      Height          =   315
      Left            =   3600
      TabIndex        =   0
      Top             =   240
      Width           =   1095
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "请输入单词："
      Height          =   180
      Left            =   240
      TabIndex        =   3
      Top             =   240
      Width           =   1080
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private StringArray1() As String
Private StringArray2() As String
Private StringArray3() As String
    
    
Private Sub Form_Load()
    Dim Str As String
    Dim arrTmp() As String
    Dim P1 As Integer
    Dim P2 As Integer
    Dim i As Integer
    
    If Right(App.Path, 1) = "\" Then
        Str = OpenFile(App.Path & "band4.txt")
    Else
        Str = OpenFile(App.Path & "\band4.txt")
    End If
    
    If Left(Str, 1) = "$" Then
        Str = Mid(Str, 2)
    End If
    
    arrTmp = Split(Str, "$")
    
    ReDim StringArray1(UBound(arrTmp)) As String
    ReDim StringArray2(UBound(arrTmp)) As String
    ReDim StringArray3(UBound(arrTmp)) As String
    
    For i = 0 To UBound(arrTmp)
        P1 = InStr(1, arrTmp(i), "[")
        P2 = InStr(1, arrTmp(i), "]")
        StringArray1(i) = Left(arrTmp(i), P1 - 1)
        StringArray2(i) = Mid(arrTmp(i), P1, P2 - P1 + 1)
        StringArray3(i) = Mid(arrTmp(i), P2 + 1)
    Next i
    
    For i = 0 To UBound(arrTmp)
        Debug.Print StringArray1(i), StringArray2(i), StringArray3(i)
    Next i
End Sub
Private Sub Command1_Click()
    Dim strFind As String
    Dim intFind As Integer
        
    If Text1.Text = "" Then
        MsgBox "请输入单词！", vbExclamation, "提示"
        Exit Sub
    End If
    
    intFind = Find(Text1.Text)
    
    If intFind = -1 Then
        MsgBox "找不到单词！", vbExclamation, "提示"
    Else
        MsgBox "单词: " & Text1.Text & vbCrLf & _
               "单标: " & StringArray2(intFind) & vbCrLf & _
               "词义: " & StringArray3(intFind), vbExclamation, "提示"
    End If
End Sub
'折半查找，如果找到了，返回一个顺序号，否则返回-1
Private Function Find(strFindKey As String) As Integer
    Dim intLow As Integer
    Dim intMid As Integer
    Dim intHigh As Integer
    
    intLow = 0
    intHigh = UBound(StringArray1)
    
    Do While intLow <= intHigh
        intMid = (intLow + intHigh) / 2
        If strFindKey = StringArray1(intMid) Then
            Find = intMid
            Exit Function
        ElseIf strFindKey < StringArray1(intMid) Then
            intHigh = intMid - 1
        ElseIf strFindKey > StringArray1(intMid) Then
            intLow = intMid + 1
        End If
    Loop
    Find = -1
End Function
'打开文件，返回一个字符串
Private Function OpenFile(szFileName As String) As String
    Dim strTemp As String
    Dim strBuff As String
    Dim FileNumber    FileNumber = FreeFile
    Open szFileName For Input As #FileNumber
    Do While Not EOF(FileNumber)
       Line Input #FileNumber, strBuff
       strTemp = strTemp & strBuff & vbCrLf
    Loop
    Close #FileNumber
    OpenFile = strTemp
End Function