大神!拜服!您的VB水平惊为天人!
学习代码中。。。。。。
头晕中。。。。。。。。
N多不懂中。。。。。。
还有两个问题求教:
1、如何删除指定的DEVICE#:号的数据段?
2、对于DEVICE#:号,还有需要修改号,改号方式如下,原文件名不变:
第一种方法:
一键修改:按一下按钮,原来乱序的NO:,被重新命名从NO:1——NO: n,(只修改NO行,其他行不变。)
第二种方法:
顺序修改:按“开始”键,出现第一个NO,例如NO: 19,在后面的一个文本框内输入一个数字,如5,该行就变成NO: 5;按“下一个”键,出现第一个NO,例如NO: 18,在后面的文本框内输入一个数字,如7,该行就变成NO: 7。。。。。。以此类推,直至该文本文件里的所有NO全部改完,如果文本框为空并点击“下一个”键,则文本文件中对应的NO值不变。注意:还要有“上一个”的功能。按保存键保存。
第三种方法:
跳跃修改:按“开始”键,两个文本框解除锁定,分别输入一个数字,前一个文本框里的数字用于寻找,寻找文本文件中NO:后面的数字;后边文本框里的数字是用于替换的。逻辑是,先在文本文件中的NO:后面查找前一个数字,如果不存在就提醒,如果存在就将后面一个数字在文本文件中替换前面找到的数字。。按保存键保存。
您曾经给过我一段程序,关于第一种和第二种的,程序如下:
程序代码:
Option Explicit
Dim No() As Long '原始序号
Dim No2() As Long '新序号
Dim NoIndex As Long '当前显示的序号
Private Sub Command1_Click()
'方法一:一键修改,第一种实现方法
'Call 顺序写入("C:\Users\CC\Desktop\记录.txt")
'方法一:第二种实现方法,可以删 顺序写入 代码,提高代码复用性
Call 读序号("C:\Users\CC\Desktop\记录.txt", No())
Dim i As Long
For i = 1 To UBound(No)
No(i) = i '按顺序排序号
Next i
Call 保存顺序("C:\Users\CC\Desktop\记录.txt", No())
End Sub
Private Sub Command2_Click()
'上一条
No2(NoIndex) = Val(Text1.Text)
Call 显示序号(-1)
End Sub
Private Sub Command3_Click()
'下一条
No2(NoIndex) = Val(Text1.Text)
Call 显示序号(1)
End Sub
Private Sub Command4_Click()
'方法二初始化程序
Call 读序号("C:\Users\CC\Desktop\记录.txt", No())
NoIndex = 1
ReDim No2(UBound(No))
Dim i As Long
For i = 1 To UBound(No)
No2(i) = No(i)
Next i
Call 显示序号
End Sub
Private Sub Command5_Click()
'方法二和方法三保存结果
Call 保存顺序("C:\Users\CC\Desktop\记录.txt", No2())
End Sub
'---------------------------------------------------
Public Sub 顺序写入(Filename As String)
'文件保存,修改NO序号为顺序号
'方法一的第一种实现方法
Dim i As Long
Dim h1 As Long, h2 As Long
Dim p As String
Dim s As String
p = App.Path
If Right(p, 1) <> "\" Then p = p & "\"
If Dir(Filename) = "" Then
MsgBox "原文件不存在", vbCritical, "错误"
Exit Sub
End If
h1 = FreeFile
Open Filename For Input As h1
h2 = FreeFile
Open p & "~tmp.txt" For Output As h2
Do While Not EOF(h1)
Line Input #h1, s
If Left(Trim(s), 4) = "NO: " Then '复制你的,含空格??
i = i + 1
s = "NO: " & i
End If
Print #h2, s
Loop
Close #h1
Close #h2
Kill Filename '删旧文件
Name p & "~tmp.txt" As Filename '重命名为目标文件,Name 可以在不同驱动器之间移动文件以完成重命名
MsgBox "完成"
End Sub
Public Sub 读序号(Filename As String, order() As Long)
'读文件里的顺序
'使用一次性读文件的方式
If Dir(Filename) = "" Then
MsgBox "原文件不存在", vbCritical, "错误"
Exit Sub
End If
Dim i As Long, j As Long
Dim s As String
Dim h As Long
Dim m() As String
Dim n() As Long
h = FreeFile
Open Filename For Binary As #h '打开文件
'直接读整个文件的所有的内容,按字节读,并转换为 Unicode 的VB默认字符串类型
s = StrConv(InputB$(LOF(h), #h), vbUnicode)
Close #h
m = Split(s, vbCrLf) 'Windows 平台,没做 Linux 平台兼容
For i = 0 To UBound(m)
m(i) = Trim(m(i))
If Left(m(i), 4) = "NO: " Then
j = j + 1
End If
Next i
ReDim order(j)
j = 0
For i = 0 To UBound(m)
m(i) = Trim(m(i))
If Left(m(i), 4) = "NO: " Then
j = j + 1
order(j) = Val(Mid(m(i), 5))
End If
Next i
End Sub
Public Sub 显示序号(Optional 位移 As Long = 0)
On Error Resume Next
If IsError(UBound(No)) Then
Exit Sub '发现错误时不显示
End If
On Error GoTo 0
NoIndex = NoIndex + 位移
If NoIndex > UBound(No) Then
NoIndex = 1
End If
If NoIndex < 1 Then
NoIndex = UBound(No)
End If
Label1.Caption = No(NoIndex) '原始值
Text1.Text = No2(NoIndex) '修改后的值
End Sub
Public Sub 保存顺序(Filename As String, order() As Long)
Dim i As Long
Dim h1 As Long, h2 As Long
Dim p As String
Dim s As String
p = App.Path
If Right(p, 1) <> "\" Then p = p & "\"
If Dir(Filename) = "" Then
MsgBox "原文件不存在", vbCritical, "错误"
Exit Sub
End If
h1 = FreeFile
Open Filename For Input As h1
h2 = FreeFile
Open p & "~tmp.txt" For Output As h2
Do While Not EOF(h1)
Line Input #h1, s
If Left(Trim(s), 4) = "NO: " Then '复制你的,含空格??
i = i + 1
s = "NO: " & order(i) '仅此与顺序文件不同
End If
Print #h2, s
Loop
Close #h1
Close #h2
Kill Filename '删旧文件
Name p & "~tmp.txt" As Filename '重命名为目标文件,Name 可以在不同驱动器之间移动文件以完成重命名
MsgBox "完成"
End Sub
如何将这段程序无缝的连接入您这次写入的程序中?您这次写的程序简直是神来之笔,对我来说如同圣经一般,里面N多N多不懂得啊!!!