2011年6月29日水曜日

→→→連続する空白を埋める

文字列途中の連続した余分な空白を詰める処理をしたときのやつ。
データはテキスト形式でタブ区切り。

テストデータ例
連番・空白を詰めたい列
1・テ  ス    ト
2・テ    ス        ト
3・テ ス ト
結果は
すべて"テ ス ト"になる


フォームにBUTTONを追加だけする
--------------------------------------------------------------



Public Class Form1
    Private Structure Info
        Public str() As String
    End Structure
    Dim strOcc() As String
    Dim FileName As String
    Dim outFileName As String
    Dim openFile1 As New OpenFileDialog
    Dim saveFile1 As New SaveFileDialog
    Dim FileNum As Integer
    Dim FileOutNum As Integer
    Dim i As Integer = 0
    Dim j As Integer = 0
    Dim DataBuff As String
    Private pInfo(1500000) As Info

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        ReadTab()
        PWrite()
    End Sub


    Private Sub ReadTab()
        Dim k As Integer
        openFile1.DefaultExt = "*.*"
        openFile1.Filter = "テキスト|*.txt|すべてのファイル|*.*"
        If openFile1.ShowDialog = DialogResult.OK Then
            Cursor.Current = Cursors.WaitCursor
            FileName = openFile1.FileName
        Else
            Exit Sub
        End If
        FileNum = FreeFile()
        FileOpen(FileNum, FileName, OpenMode.Input)
        Do Until EOF(FileNum)
            If i > 1499999 Then
                MessageBox.Show("150万超えたためSTOP", "ERR", MessageBoxButtons.OK, MessageBoxIcon.Error)
                Me.Close()
                Exit Sub
            End If
            DataBuff = LineInput(FileNum)
            strOcc = Split(DataBuff, vbTab)
            j = UBound(strOcc)
            ReDim pInfo(i).str(j)
            For k = 0 To j
                pInfo(i).str(k) = strOcc(k)
                If k = j Then
                    pass(pInfo(i).str(j))
                End If
            Next
            i += 1
        Loop
        Cursor.Current = Cursors.Default
        FileClose(FileNum)
    End Sub


    Private Sub PWrite()
        Dim p As Integer = 0
        Dim q As Integer = 0
        saveFile1.DefaultExt = "*.txt"
        saveFile1.Filter = "保存するファイル名|*.txt"
        If saveFile1.ShowDialog = Windows.Forms.DialogResult.OK Then
            outFileName = saveFile1.FileName
        Else
            Exit Sub
        End If
        FileOutNum = FreeFile()
        FileOpen(FileOutNum, outFileName, OpenMode.Output)
        For p = 0 To i - 1
            For q = 0 To j - 1
                Write(FileOutNum, pInfo(p).str(q))
            Next
            WriteLine(FileOutNum, pInfo(p).str(j))
        Next
        MessageBox.Show(i & "件のデータを保存しました", "名前を付けて保存")
        FileClose(FileNum)
    End Sub

    Private Function pass(ByRef result As String)
        Dim rp1, rp2, rp3, FLG As Integer
        Dim txt As String = ""
        Dim stw() As String
        rp2 = Len(result)
        ReDim stw(rp2 - 1)
        For rp1 = 0 To rp2 - 1
            stw(rp1) = result.Substring(rp1, 1)
            rp3 = StrComp(stw(rp1), " ")
            If rp3 = 0 Then
                If FLG = 0 Then
                    FLG = 1
                    txt = txt & stw(rp1)
                Else
                    '何もしない
                End If
            Else
                txt = txt & stw(rp1)
                FLG = 0
            End If
        Next
        result = txt
        Return result
    End Function
End Class

0 件のコメント:

コメントを投稿