SAK 図書館
SAK 図書館
VB テクニック編6 - CSV ファイル項目数取得、クイックソート昇順・降順
■SAK 関数利用規程
・テクニック編で紹介する関数は、私こと Y.SAK の開発関数である。
・著作権明示部分の改編は認めない。
・個人、企業がこれらの関数を使用したり、一部を使用して新たなシステムや
プログラムを開発することは自由です。
・但し、これらの関数を一部でも使用しているソフトウェアをシェアウェア、
その他有償プロダクトとして配布・販売するには、私の許可が必要です。
(無償のフリーソフトウェアなら、自由に配布しても良い。)
・これらの関数を使用して発生した、いかなる形での損害も私こと Y.SAK は
賠償しません。
■CSV ファイル項目数取得
【使い方】
msgbox GetCntCSV("g:\tmp\test.csv")
'=======================================================================
' CSV ファイル項目数取得
'=======================================================================
'【引数】
' fnm = CSV ファイル名
'【戻り値】
' integer = 項目数
' 0 エラー
'【処理】
' ・CSV ファイルの項目数を求めて返す。
'【著作権】
' GetCntCSV() ver 1.00 Copyright (C) 1999 Y.SAK
'【履歴】
' 1999.04.17 sak ver 1.00 新規作成
'=======================================================================
Public Function GetCntCSV(fnm As String) As Integer
Dim fno As Integer
Dim rec As String
Dim i As Integer
Dim j As Integer
Dim cnt As Integer
'** CSV ファイル 1 行リード
On Local Error Resume Next
fno = FreeFile
Open fnm For Input As fno Len = 32000
Line Input #fno, rec
If Err <> 0 Then
Close fno
On Local Error GoTo 0
GetCntCSV = 0
Exit Function
End If
Close fno
On Local Error GoTo 0
'** CSV ファイル項目数計算
cnt = 0
i = 1
j = Len(rec)
Do
If Mid(rec, i, 1) = Chr(&H22) Then
For i = i + 1 To j
If Mid(rec, i, 1) = Chr(&H22) Then Exit For
Next
If i > j Then
GetCntCSV = 0
Exit Function
Else
i = i + 1
End If
End If
If Mid(rec, i, 1) = "," Then
cnt = cnt + 1
End If
i = i + 1
Loop Until i > j
'** 戻り値セット
If cnt > 0 Then
GetCntCSV = cnt + 1
Else
GetCntCSV = 0
End If
End Function
■CSV ファイル項目読み込み
・CSV ファイルの特定項目のみリード処理する場合、次のようにする。
dim fnm as string
dim b as string
dim dmy as string
fnm = "g:\tmp\test.csv"
open fnm for input as #1 len = 32000
do until eof(1)
input #1, dmy, b, dmy, dmy, dmy
... b の処理 ...
loop
close #1
■CSV ファイル項目並び編集
・CSV ファイルの項目並びを加工編集する場合、次のようにする。
dim fnm as string
dim fnm2 as string
dim a(4) as string
dim rec as string
dim i as long
fnm = "g:\tmp\test.csv"
fnm2 = "g:\tmp\test2.csv"
open fnm for input as #1 len = 32000
open fnm2 for output as #2 len = 32000
do until eof(1)
for i = 0 to 4
input #1, a(i)
next
rec = chr(&H22) & a(4) & chr(&H22)
rec = rec & "," & chr(&H22) & a(3) & chr(&H22)
rec = rec & "," & chr(&H22) & a(1) & chr(&H22)
rec = rec & "," & chr(&H22) & a(2) & chr(&H22)
rec = rec & "," & chr(&H22) & a(0) & chr(&H22)
print #2, rec
loop
close #2
close #1
■クイックソート昇順
【使い方】
・これは、関数再帰呼び出しによるクイックソートである。
最速ソートの部類に属する。
引数を variant としているので、数値ソート、数字ソート、文字ソート、
文字列ソートに使用できる。(配列の並び替え)
dim a(99) as variant
dim amax as long
dim i as long
amax = -1
for i = 0 to 99
a(i) = int(rnd(1) * 1000000)
amax = amax + 1
next
if amax > 0 then QSort a(), 0, amax
for i = 0 to amax
print a(i)
next
'=======================================================================
' クイックソート昇順
'=======================================================================
'【引数】
' d() = 【入出力】配列
' l = ソート開始添字
' r = ソート終了添字
'【戻り値】
' なし
'【処理】
' ・クイックソートする。
'【著作権】
' QSort() ver 1.00 Copyright (C) 2000 Y.SAK
'【履歴】
' 2000.01.27 sak ver 1.00 新規作成
'=======================================================================
Public Sub QSort(d() As Variant, l As Variant, r As Variant)
Dim i As long
Dim j As long
Dim x As variant
Dim w As variant
'** クイックソート
x = d((l + r) \ 2)
i = l
j = r
do
do while d(i) < x
i = i + 1
loop
do while d(j) > x
j = j - 1
loop
if i >= j then exit do
w = d(i)
d(i) = d(j)
d(j) = w
i = i + 1
j = J - 1
loop
if (l < i - 1) then QSort d(), l, i - 1
if (r > j + 1) then QSort d(), j + 1, r
End Sub
■クイックソート降順
【使い方】
・これは、関数再帰呼び出しによるクイックソートである。
最速ソートの部類に属する。
引数を variant としているので、数値ソート、数字ソート、文字ソート、
文字列ソートに使用できる。
dim a(99) as variant
dim amax as long
dim i as long
amax = -1
for i = 0 to 99
a(i) = int(rnd(1) * 1000000)
amax = amax + 1
next
if amax > 0 then QSortD a(), 0, amax
for i = 0 to amax
print a(i)
next
'=======================================================================
' クイックソート降順
'=======================================================================
'【引数】
' d() = 【入出力】配列
' l = ソート開始添字
' r = ソート終了添字
'【戻り値】
' なし
'【処理】
' ・クイックソートする。
'【著作権】
' QSortD() ver 1.00 Copyright (C) 2000 Y.SAK
'【履歴】
' 2000.01.27 sak ver 1.00 新規作成
'=======================================================================
Public Sub QSortD(d() As Variant, l As Variant, r As Variant)
Dim i As long
Dim j As long
Dim x As variant
Dim w As variant
'** クイックソート
x = d((l + r) \ 2)
i = l
j = r
do
do while d(i) > x
i = i + 1
loop
do while d(j) < x
j = j - 1
loop
if i >= j then exit do
w = d(i)
d(i) = d(j)
d(j) = w
i = i + 1
j = J - 1
loop
if (l < i - 1) then QSortD d(), l, i - 1
if (r > j + 1) then QSortD d(), j + 1, r
End Sub
■VB テクニック編資料
■VB 入門編資料
■VB 基礎編資料
■VB ビジュアル編資料
Copyright (C) 1999-2024 Y.SAK