24小时热门版块排行榜    

查看: 1171  |  回复: 13

chelator

木虫 (小有名气)

代码如下
Dim a() As Single
Dim LineNum  As Long

Private Sub Command1_Click()

Dim i, j, k As Long

Dim TextLine As String
Dim EachText() As String
LineNum = 0
Open App.Path & "\data.txt" For Input As #1
Do While Not EOF(1)
   Line Input #1, TextLine
   LineNum = LineNum + 1
Loop
Close #1

ReDim a(LineNum - 1, 2)

Open App.Path & "\data.txt" For Input As #1

i = 0
Do While Not EOF(1)
    Line Input #1, TextLine
    EachText = Split(TextLine, " ", -1, vbTextCompare)
    k = 0
    For j = 0 To UBound(EachText)
        If EachText(j) <> "" Then
            a(i, k) = CSng(EachText(j))
            k = k + 1
        End If
    Next
   i = i + 1
Loop
Close #1

Command2.Enabled = True

MsgBox ("读取数据成功"
End Sub

Private Sub Command2_Click()
Dim Xmax, Xmin, Ymax, Ymin, Zvalue As Single
Dim Count As Long

If IsNumeric(TextXMax.Text) And IsNumeric(TextXMin.Text) And _
IsNumeric(TextYMax.Text) And IsNumeric(TextYMin.Text) And _
IsNumeric(TextZ.Text) Then
    Xmax = CSng(TextXMax.Text)
    Xmin = CSng(TextXMin.Text)
    Ymax = CSng(TextYMax.Text)
    Ymin = CSng(TextYMin.Text)
    Zvalue = CSng(TextZ.Text)
   
    If Xmax < Xmin Then
        MsgBox ("X最大最小值有误"
        Exit Sub
    End If
   
    If Ymax < Ymin Then
        MsgBox ("Y最大最小值有误"
        Exit Sub
    End If
   
   
    Open App.Path & "\result.txt" For Output As #1
        For i = 0 To LineNum - 1
            If a(i, 0) <= Xmax And a(i, 0) >= Xmin And _
                a(i, 1) <= Ymax And a(i, 1) >= Ymin And _
                a(i, 2) <> Z Then
                Print #1, a(1, 0) & "  " & a(i, 1) & "  " & a(i, 2)
                Count = Count + 1
            End If
        Next
    Close #1
   
    MsgBox ("有" & CStr(Count) & "行输出"
Else
    MsgBox ("请输入数字"
End If
End Sub
11楼2013-04-11 09:31:38
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

chelator

木虫 (小有名气)

其中
Xmax = CSng(TextXMax.Text)
    Xmin = CSng(TextXMin.Text)
    Ymax = CSng(TextYMax.Text)
    Ymin = CSng(TextYMin.Text)
    Zvalue = CSng(TextZ.Text)

TextXMax 是你的TextBox,我重新命名了。
12楼2013-04-11 09:33:27
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

chelator

木虫 (小有名气)

错误数据的行号

1771
2158
3453
4806
5256
5446
8162
8549
9844
12091
12478
13773
13楼2013-04-11 09:33:57
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

zjzc511

银虫 (小有名气)

代码如下
Dim a() As Single
Dim LineNum  As Long
Private Sub Command1_Click()
Dim i, j, k As Long
Dim TextLine As String
Dim EachText() As String
LineNum = 0
Open App.Path & "\data.txt" For Input As #1
Do While Not EOF(1)
   Line Input #1, TextLine
   LineNum = LineNum + 1
Loop
Close #1
ReDim a(LineNum - 1, 2)
Open App.Path & "\data.txt" For Input As #1
i = 0
Do While Not EOF(1)
    Line Input #1, TextLine
    EachText = Split(TextLine, " ", -1, vbTextCompare)
    k = 0
    For j = 0 To UBound(EachText)
        If EachText(j) <> "" Then
            a(i, k) = CSng(EachText(j))
            k = k + 1
        End If
    Next
   i = i + 1
Loop
Close #1
Command2.Enabled = True
MsgBox ("读取数据成功"
End Sub
Private Sub Command2_Click()
Dim Xmax, Xmin, Ymax, Ymin, Zvalue As Single
Dim Count As Long
If IsNumeric(TextXMax.Text) And IsNumeric(TextXMin.Text) And _
IsNumeric(TextYMax.Text) And IsNumeric(TextYMin.Text) And _
IsNumeric(TextZ.Text) Then
    Xmax = CSng(TextXMax.Text)
    Xmin = CSng(TextXMin.Text)
    Ymax = CSng(TextYMax.Text)
    Ymin = CSng(TextYMin.Text)
    Zvalue = CSng(TextZ.Text)
   
    If Xmax < Xmin Then
        MsgBox ("X最大最小值有误"
        Exit Sub
    End If
   
    If Ymax < Ymin Then
        MsgBox ("Y最大最小值有误"
        Exit Sub
    End If
   
   
    Open App.Path & "\result.txt" For Output As #1
        For i = 0 To LineNum - 1
            If a(i, 0) <= Xmax And a(i, 0) >= Xmin And _
                a(i, 1) <= Ymax And a(i, 1) >= Ymin And _
                a(i, 2) <> Z Then
                Print #1, a(1, 0) & "  " & a(i, 1) & "  " & a(i, 2)
                Count = Count + 1
            End If
        Next
    Close #1
   
    MsgBox ("有" & CStr(Count) & "行输出"
Else
    MsgBox ("请输入数字"
End If
End Sub
23
14楼2014-05-31 21:06:44
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
相关版块跳转 我要订阅楼主 huzijun888 的主题更新
信息提示
请填处理意见