请大家赶快来顶!!!急求哦！！真挚的感谢！！

Question

这段代码为：txt文本中奇数行显示在列表框中，该奇数加一行显示在text1中 
VB代码 Dim a()
Private Sub Form_Load()Dim i As Integer, j As Integer
fname = "C:\001.txt"
 Open fname For Input As #1
 i = 1
Do Until EOF(1)
 Line Input #1, nextline
If i Mod 2 <> 0 Then
     List1.AddItem nextline
      Else
     ReDim Preserve a(j)
     a(j) = nextline
     j = j + 1
      End If
       i = i + 1
  Loop
Close #1
End Sub
Private Sub List1_Click()
Text1 = a(List1.ListIndex)
End Sub
我现在要加一个删除按钮，现在list1中选一项，再点击删除按钮，则删除txt文本中该奇数行和该奇数+1（偶数行），保存哦！！急求VB代码！！

Answer 1

private sub command2_click()
    fname = "C:\001.txt"
    if DeleteLine(fname,list1.list(List1.ListIndex)) then msgbox "ok1"
    if DeleteLine(fname,list1.list(List1.ListIndex)+1) then msgbox "ok2"end subPublic   Function   DeleteLine(fName   As   String,   LineNumber   As   Long)   _   
            As   Boolean   
  '功能:   从指定的文本文件删除指定的行   
    
  '参数:   fName   =   完整的文本文件路径名+文件名   
  '                         LineNumber   =   要删除的行数(数字)   
    
  '返回:         True   为正确执行,   false   其它失败错误   
    
  '需要:       引用--   Microsoft   Scripting   Runtime   
    
  'Example:   DeleteLine("C:\Myfile.txt",   3)   
  '                     从   Myfile.txt   删除第三行的内容   
  '______________________________________________________________   
                                                  
    
      Dim   oFSO   As   New   FileSystemObject   
      Dim   oFSTR   As   Scripting.TextStream   
      Dim   ret   As   Long   
      Dim   lCtr   As   Long   
      Dim   sTemp   As   String,   sLine   As   String   
      Dim   bLineFound   As   Boolean   
        
      On   Error   GoTo   ErrorHandler   
      If   oFSO.FileExists(fName)   Then   
            Set   oFSTR   =   oFSO.OpenTextFile(fName)   
          lCtr   =   1   
            Do   While   Not   oFSTR.AtEndOfStream   
                  sLine   =   oFSTR.ReadLine   
                  If   lCtr   <>   LineNumber   Then   
                          sTemp   =   sTemp   &   sLine   &   vbCrLf   
                  Else   
                          bLineFound   =   True   
                            
                  End   If   
                  lCtr   =   lCtr   +   1   
          Loop   
          
            oFSTR.Close   
            Set   oFSTR   =   oFSO.CreateTextFile(fName,   True)   
            oFSTR.Write   sTemp   
        
          DeleteLine   =   bLineFound   
        End   If   
          
    
  ErrorHandler:   
  On   Error   Resume   Next   
  oFSTR.Close   
  Set   oFSTR   =   Nothing   
  Set   oFSO   =   Nothing   
    
  End   Function   
    
  Private   Sub   Command1_Click()   
  Call   DeleteLine("C:\aa.txt",   2)   
  '通用   
  End   Sub

Answer 2

调用
private sub command2_click()
    fname = "C:\001.txt"
    if DeleteLine(fname,list1.list(List1.ListIndex)) then msgbox "ok1"
    if DeleteLine(fname,list1.list(List1.ListIndex)+1) then msgbox "ok2"end sub删除函数
Public   Function   DeleteLine(fName   As   String,   LineNumber   As   Long)   _   
            As   Boolean   
  '功能:   从指定的文本文件删除指定的行   
    
  '参数:   fName   =   完整的文本文件路径名+文件名   
  '                         LineNumber   =   要删除的行数(数字)   
    
  '返回:         True   为正确执行,   false   其它失败错误   
    
  '需要:       引用--   Microsoft   Scripting   Runtime   
    
  'Example:   DeleteLine("C:\Myfile.txt",   3)   
  '                     从   Myfile.txt   删除第三行的内容   
  '______________________________________________________________   
                                                  
    
      Dim   oFSO   As   New   FileSystemObject   
      Dim   oFSTR   As   Scripting.TextStream   
      Dim   ret   As   Long   
      Dim   lCtr   As   Long   
      Dim   sTemp   As   String,   sLine   As   String   
      Dim   bLineFound   As   Boolean   
        
      On   Error   GoTo   ErrorHandler   
      If   oFSO.FileExists(fName)   Then   
            Set   oFSTR   =   oFSO.OpenTextFile(fName)   
          lCtr   =   1   
            Do   While   Not   oFSTR.AtEndOfStream   
                  sLine   =   oFSTR.ReadLine   
                  If   lCtr   <>   LineNumber   Then   
                          sTemp   =   sTemp   &   sLine   &   vbCrLf   
                  Else   
                          bLineFound   =   True   
                            
                  End   If   
                  lCtr   =   lCtr   +   1   
          Loop   
          
            oFSTR.Close   
            Set   oFSTR   =   oFSO.CreateTextFile(fName,   True)   
            oFSTR.Write   sTemp   
        
          DeleteLine   =   bLineFound   
        End   If   
          
    
  ErrorHandler:   
  On   Error   Resume   Next   
  oFSTR.Close   
  Set   oFSTR   =   Nothing   
  Set   oFSO   =   Nothing   
    
  End   Function   
    

Answer 3

byref 参数类型不符　　If DeleteLine(fName, List1.List(List1.ListIndex)) Then MsgBox "ok1"　　中的　fName　显示有错误！！

Answer 4

Dim a()
Const fname = "C:\001.txt"Private Sub Form_Load()Dim i As Integer, j As Integer
Text1 = ""
Open fname For Input As #1
i = 1
Do Until EOF(1)
Line Input #1, nextline
If i Mod 2 <> 0 Then
    List1.AddItem nextline
      Else
    ReDim Preserve a(j)
    a(j) = nextline
    j = j + 1
      End If
      i = i + 1
  Loop
Close #1
End Sub
Private Sub List1_Click()
Text1 = a(List1.ListIndex)
End Sub
Private Sub Command1_Click()
S = List1.List(0) & vbCrLf & a(0) & vbCrLf
For i = 1 To List1.ListCount - 1
If i <> List1.ListIndex Then
S = S & List1.List(i) & vbCrLf & a(i) & vbCrLf
End If
Next
S = Left(S, Len(S) - 2)
 RemoveItem List1.ListIndex
Open fname For Output As #1
Print #1, S
Close #1
List1.RemoveItem List1.ListIndex
List1.Refresh
Text1 = ""
End Sub
Private Sub RemoveItem(ByVal Item As String)
Dim b()
Dim i As Integer, k As Integer
For i = 0 To UBound(a)
If i <> List1.ListIndex Then
ReDim Preserve b(k)
b(k) = a(i)
k = k + 1
End If
Next
ReDim a(UBound(a) - 1)
a = b
End Sub

Answer 5

'试试这个
Option ExplicitDim a()
Private Sub init()
    Dim i As Integer, j As Integer
    Dim fname As String, nextline As String, s As String
    fname = "D:\Downloads\001.txt"
    Open fname For Input As #1
    i = 1
    List1.Clear
    Do Until EOF(1)
        Line Input #1, nextline
        If i Mod 2 <> 0 Then
            List1.AddItem nextline
              Else
            ReDim Preserve a(j)
            a(j) = nextline
            j = j + 1
            s = s + nextline + vbCrLf
        End If
        i = i + 1
    Loop
    Close #1
    Text1.Text = s
End Sub
Private Sub Command1_Click()
    Dim s As String, i As Integer, t As String
    s = List1.List(List1.ListIndex)
    MsgBox s
    
    Dim fname As String, nextline As String
    fname = "D:\Downloads\001.txt"
    Open fname For Input As #1
    Do Until EOF(1)
        Line Input #1, nextline
        If i = 1 Then
           nextline = ""
           i = 2
        End If
        If nextline = s Then
           nextline = ""
           i = i + 1
        End If
        If nextline <> "" Then t = t + nextline + vbCrLf
    Loop
    Close #1
    Open fname For Output As #1
    Print #1, t
    Close #1
    Call init
End Sub
Private Sub Form_Load()
    Call init
End SubPrivate Sub List1_Click()
'Text1 = a(List1.ListIndex)
End Sub

Answer 6

最后倒数　３行　ReDim a(UBound(a) - 1) 显示错误哦！显示下标越界　！

Answer 7

Private Sub Command2_Click()
    Dim strFileName As String
    
    strFileName = "e:\qqq.txt"
    
    If DeleteLine(strFileName, List1.List(List1.ListIndex)) Then
        MsgBox "ok1"
        
        If DeleteLine(strFileName, List1.List(List1.ListIndex)) Then
            MsgBox "ok2"
            List2.RemoveItem (List1.ListIndex)
            List1.RemoveItem (List1.ListIndex)
        End If
    End IfEnd SubPublic Function DeleteLine(fName As String, LineNumber As Long) As Boolean
  '功能:   从指定的文本文件删除指定的行
    
  '参数:   fName   =   完整的文本文件路径名+文件名
  '                         LineNumber   =   要删除的行数(数字)
    
  '返回:         True   为正确执行,   false   其它失败错误
    
  '需要:       引用--   Microsoft   Scripting   Runtime
    
  'Example:   DeleteLine("C:\Myfile.txt",   3)
  '                     从   Myfile.txt   删除第三行的内容
  '______________________________________________________________
                                                  
    
      Dim oFSO     As New FileSystemObject
      Dim oFSTR     As Scripting.TextStream
      Dim ret     As Long
      Dim lCtr     As Long
      Dim sTemp     As String, sLine       As String
      Dim bLineFound     As Boolean
        
      On Error GoTo ErrorHandler
      If oFSO.FileExists(fName) Then
            Set oFSTR = oFSO.OpenTextFile(fName)
          lCtr = 1
            Do While Not oFSTR.AtEndOfStream
                  sLine = oFSTR.ReadLine
                  If lCtr <> LineNumber Then
                          sTemp = sTemp & sLine & vbCrLf
                  Else
                          bLineFound = True
                            
                  End If
                  lCtr = lCtr + 1
          Loop
          
            oFSTR.Close
            Set oFSTR = oFSO.CreateTextFile(fName, True)
            oFSTR.Write sTemp
        
          DeleteLine = bLineFound
        End If
          
    
ErrorHandler:
  On Error Resume Next
  oFSTR.Close
  Set oFSTR = Nothing
  Set oFSO = Nothing
    
  End Function

Answer 8

加上次全部
Private Sub Command1_Click()
    Dim strFileName As String
    Dim strTemp As String
    
    List2.Visible = False
    
    strFileName = "e:\qqq.txt"
    Open strFileName For Input As #1
    
    Do Until EOF(1)
        i = i + 1
        Line Input #1, strTemp
        
        If (i Mod 2) = 1 Then
            List1.AddItem strTemp
        Else
            List2.AddItem strTemp
        End If
    Loop
    
    Close #1
    
End SubPrivate Sub List1_Click()
    
    Text1.Text = List2.List(List1.ListIndex)
    
End SubPrivate Sub Command2_Click()
    Dim strFileName As String
    
    strFileName = "e:\qqq.txt"
    
    If DeleteLine(strFileName, List1.List(List1.ListIndex)) Then
        MsgBox "ok1"
        
        If DeleteLine(strFileName, List1.List(List1.ListIndex)) Then
            MsgBox "ok2"
            List2.RemoveItem (List1.ListIndex)
            List1.RemoveItem (List1.ListIndex)
        End If
    End IfEnd SubPublic Function DeleteLine(fName As String, LineNumber As Long) As Boolean
  '功能:   从指定的文本文件删除指定的行
    
  '参数:   fName   =   完整的文本文件路径名+文件名
  '                         LineNumber   =   要删除的行数(数字)
    
  '返回:         True   为正确执行,   false   其它失败错误
    
  '需要:       引用--   Microsoft   Scripting   Runtime
    
  'Example:   DeleteLine("C:\Myfile.txt",   3)
  '                     从   Myfile.txt   删除第三行的内容
  '______________________________________________________________
                                                  
    
      Dim oFSO     As New FileSystemObject
      Dim oFSTR     As Scripting.TextStream
      Dim ret     As Long
      Dim lCtr     As Long
      Dim sTemp     As String, sLine       As String
      Dim bLineFound     As Boolean
        
      On Error GoTo ErrorHandler
      If oFSO.FileExists(fName) Then
            Set oFSTR = oFSO.OpenTextFile(fName)
          lCtr = 1
            Do While Not oFSTR.AtEndOfStream
                  sLine = oFSTR.ReadLine
                  If lCtr <> LineNumber Then
                          sTemp = sTemp & sLine & vbCrLf
                  Else
                          bLineFound = True
                            
                  End If
                  lCtr = lCtr + 1
          Loop
          
            oFSTR.Close
            Set oFSTR = oFSO.CreateTextFile(fName, True)
            oFSTR.Write sTemp
        
          DeleteLine = bLineFound
        End If
          
    
ErrorHandler:
  On Error Resume Next
  oFSTR.Close
  Set oFSTR = Nothing
  Set oFSO = Nothing
    
  End Function

Answer 9

防止奇偶不同数
已经测试通过Private Sub Command1_Click()
    Dim strFileName As String
    Dim strTemp As String
    
    List2.Visible = False
    
    strFileName = "e:\qqq.txt"
    Open strFileName For Input As #1
    
    Do Until EOF(1)
        i = i + 1
        Line Input #1, strTemp
        
        If (i Mod 2) = 1 Then
            List1.AddItem strTemp
        Else
            List2.AddItem strTemp
        End If
    Loop
    
    Close #1
    
End SubPrivate Sub List1_Click()
    If List1.ListIndex <= List2.ListCount - 1 Then
        Text1.Text = List2.List(List1.ListIndex)
    End If
    
End SubPrivate Sub Command2_Click()
    Dim strFileName As String
    
    strFileName = "e:\qqq.txt"
    
    If DeleteLine(strFileName, List1.List(List1.ListIndex)) Then
        MsgBox "ok1"
        
        If List1.ListIndex <= List2.ListCount - 1 Then
            If DeleteLine(strFileName, List1.List(List1.ListIndex)) Then
                MsgBox "ok2"
                List2.RemoveItem (List1.ListIndex)
                List1.RemoveItem (List1.ListIndex)
            End If
        Else
        
            List1.RemoveItem (List1.ListIndex)
        End If
    End IfEnd SubPublic Function DeleteLine(fName As String, LineNumber As Long) As Boolean
  '功能:   从指定的文本文件删除指定的行
    
  '参数:   fName   =   完整的文本文件路径名+文件名
  '                         LineNumber   =   要删除的行数(数字)
    
  '返回:         True   为正确执行,   false   其它失败错误
    
  '需要:       引用--   Microsoft   Scripting   Runtime
    
  'Example:   DeleteLine("C:\Myfile.txt",   3)
  '                     从   Myfile.txt   删除第三行的内容
  '______________________________________________________________
                                                  
    
      Dim oFSO     As New FileSystemObject
      Dim oFSTR     As Scripting.TextStream
      Dim ret     As Long
      Dim lCtr     As Long
      Dim sTemp     As String, sLine       As String
      Dim bLineFound     As Boolean
        
      On Error GoTo ErrorHandler
      If oFSO.FileExists(fName) Then
            Set oFSTR = oFSO.OpenTextFile(fName)
          lCtr = 1
            Do While Not oFSTR.AtEndOfStream
                  sLine = oFSTR.ReadLine
                  If lCtr <> LineNumber Then
                          sTemp = sTemp & sLine & vbCrLf
                  Else
                          bLineFound = True
                            
                  End If
                  lCtr = lCtr + 1
          Loop
          
            oFSTR.Close
            Set oFSTR = oFSO.CreateTextFile(fName, True)
            oFSTR.Write sTemp
        
          DeleteLine = bLineFound
        End If
          
    
ErrorHandler:
  On Error Resume Next
  oFSTR.Close
  Set oFSTR = Nothing
  Set oFSO = Nothing
    
  End Function

Answer 10

老张　那段代码 列表删除到最后一行奇数时，　最后倒数　３行　ReDim a(UBound(a) - 1) 显示错误哦！显示下标越界　！

Answer 11

其实你上次代码
Private Sub List1_Click() 
Text1 = a(List1.ListIndex) 
End Sub 就存在这个问题

Answer 12

我7楼的代码测试没有任何问题,删除一条,还能动态刷新列表框和文本框.如还有疑问代码发给你
[email protected]内容
11111
2222222
333333
444444444
5555555
666666
777777777777777777777
8888888
9999999
100000000

Answer 13

Dim a()
Const fname = "C:\001.txt"Private Sub Form_Load()Dim i As Integer, j As Integer
Text1 = ""
Open fname For Input As #1
i = 1
Do Until EOF(1)
Line Input #1, nextline
If i Mod 2 <> 0 Then
    List1.AddItem nextline
      Else
    ReDim Preserve a(j)
    a(j) = nextline
    j = j + 1
      End If
      i = i + 1
  Loop
  If List1.ListIndex > UBound(a) Then
    ReDim Preserve a(j)
    a(j) = ""
    End If
Close #1
End Sub
Private Sub List1_Click()
Text1 = a(List1.ListIndex)
End Sub
Private Sub Command1_Click()
S = List1.List(0) & vbCrLf & a(0) & vbCrLf
For i = 1 To List1.ListCount - 1
If i <> List1.ListIndex Then
S = S & List1.List(i) & vbCrLf & a(i) & vbCrLf
End If
Next
S = Left(S, Len(S) - 2)
If List1.ListIndex = 0 Then S = ""
Open fname For Output As #1
Print #1, S
Close #1
List1.RemoveItem List1.ListIndex
List1.Refresh
Text1 = ""
 RemoveItem List1.ListIndex
End Sub
Private Sub RemoveItem(ByVal Item As String)
Dim b()
Dim i As Integer, k As Integer
For i = 0 To UBound(a)
If i <> List1.ListIndex Then
ReDim Preserve b(k)
b(k) = a(i)
k = k + 1
End If
Next
If UBound(a) - 1 < 0 Then Exit Sub
ReDim a(UBound(a) - 1)
a = bEnd Sub

Answer 14

纠正二处拼写错误:
Dim a()
Const fname = "C:\001.txt"Private Sub Form_Load()Dim i As Integer, j As Integer
Text1 = ""
Open fname For Input As #1
i = 1
Do Until EOF(1)
Line Input #1, nextline
If i Mod 2 <> 0 Then
    List1.AddItem nextline
      Else
    ReDim Preserve a(j)
    a(j) = nextline
    j = j + 1
      End If
      i = i + 1
  Loop
  Debug.Print List1.ListIndex & "/" & UBound(a)
  If List1.ListCount - 1 > UBound(a) Then
  
    ReDim Preserve a(j)
    a(j) = ""
    End If
Close #1
End Sub
Private Sub List1_Click()Text1 = a(List1.ListIndex)
End Sub
Private Sub Command1_Click()
S = List1.List(0) & vbCrLf & a(0) & vbCrLf
For i = 1 To List1.ListCount - 1
If i <> List1.ListIndex Then
S = S & List1.List(i) & vbCrLf & a(i) & vbCrLf
End If
Next
S = Left(S, Len(S) - 2)
If List1.ListCount = 1 Then S = ""
Open fname For Output As #1
Print #1, S
Close #1
List1.RemoveItem List1.ListIndex
List1.Refresh
Text1 = ""
 RemoveItem List1.ListIndex
End Sub
Private Sub RemoveItem(ByVal Item As String)
Dim b()
Dim i As Integer, k As Integer
For i = 0 To UBound(a)
If i <> List1.ListIndex Then
ReDim Preserve b(k)
b(k) = a(i)
k = k + 1
End If
Next
If UBound(a) - 1 < 0 Then Exit Sub
ReDim a(UBound(a) - 1)
a = bEnd Sub

Answer 15

Private Sub Command1_Click()
    Dim strFileName As String
    Dim strTemp As String
    
    List2.Visible = False
    
    strFileName = "e:\qqq.txt"
    Open strFileName For Input As #1
    
    Do Until EOF(1)
        i = i + 1
        Line Input #1, strTemp
        
        If (i Mod 2) = 1 Then
            List1.AddItem strTemp
        Else
            List2.AddItem strTemp
        End If
    Loop
    
    Close #1
    
End SubPrivate Sub List1_Click()
    If List1.ListIndex <= List2.ListCount - 1 Then
        Text1.Text = List2.List(List1.ListIndex)
    End If
    
End SubPrivate Sub Command2_Click()
    Dim strFileName As String
    
    strFileName = "e:\qqq.txt"
    
    If DeleteLine(strFileName, List1.List(List1.ListIndex)) Then
        MsgBox "ok1"
        
        If List1.ListIndex <= List2.ListCount - 1 Then
            If DeleteLine(strFileName, List1.List(List1.ListIndex)) Then
                MsgBox "ok2"
                List2.RemoveItem (List1.ListIndex)
                List1.RemoveItem (List1.ListIndex)
            End If
        Else
        
            List1.RemoveItem (List1.ListIndex)
        End If
    End IfEnd SubPublic Function DeleteLine(fName As String, LineNumber As Long) As Boolean
  '功能:   从指定的文本文件删除指定的行
    
  '参数:   fName   =   完整的文本文件路径名+文件名
  '                         LineNumber   =   要删除的行数(数字)
    
  '返回:         True   为正确执行,   false   其它失败错误
    
  '需要:       引用--   Microsoft   Scripting   Runtime
    
  'Example:   DeleteLine("C:\Myfile.txt",   3)
  '                     从   Myfile.txt   删除第三行的内容
  '______________________________________________________________
                                                  
    
      Dim oFSO     As New FileSystemObject
      Dim oFSTR     As Scripting.TextStream
      Dim ret     As Long
      Dim lCtr     As Long
      Dim sTemp     As String, sLine       As String
      Dim bLineFound     As Boolean
        
      On Error GoTo ErrorHandler
      If oFSO.FileExists(fName) Then
            Set oFSTR = oFSO.OpenTextFile(fName)
          lCtr = 1
            Do While Not oFSTR.AtEndOfStream
                  sLine = oFSTR.ReadLine
                  If lCtr <> LineNumber Then
                          sTemp = sTemp & sLine & vbCrLf
                  Else
                          bLineFound = True
                            
                  End If
                  lCtr = lCtr + 1
          Loop
          
            oFSTR.Close
            Set oFSTR = oFSO.CreateTextFile(fName, True)
            oFSTR.Write sTemp
        
          DeleteLine = bLineFound
        End If
          
    
ErrorHandler:
  On Error Resume Next
  oFSTR.Close
  Set oFSTR = Nothing
  Set oFSO = Nothing
    
  End Function