コードを教えてください。

質問

VB6.0をたしなむ程度に扱っているものです。
次のような処理をやりたいと思っているのですが、具体的なコードを教えていただければ嬉しいです。いろいろ記述方法はあると思いますが、みなさんの意見を参考にして、よりよいものを作りたいと思います。よろしくお願いします。処理の内容は下記になります。
１．テキストファイル内のタブ区切りのデータを、何個目のタブ区切りか指定して、その部分を取得するファンクションプロシージャ。
２．10進数を2進数に変換するファンクションプロシージャ。またその逆。

回答No.2

okormazd · ベストアンサー

1.
1行は取り込めるとして、csvlineに取り込み、i番目のデータを取得して返す。

Function getcsvpart(csvline As String, i As Integer) As String

Dim dat As Variant

dat = Split(csvline, vbTab)
getcsvpart = dat(i - 1)

End Function

2.
１０進→２進
Function dec2bin(d As Long) As String

Dim bin As String, b1 As Integer

bin = ""
While d > 1
b1 = d Mod 2
bin = CStr(b1) & bin
d = d \ 2
Wend
bin = CStr(d) & bin

dec2bin = bin

End Function
と、
２進→１０進
Function bin2dec(b As String) As Long

Dim n As Integer, i As Integer, b1 As Integer, d As Long
n = Len(b)
For i = 1 To n
b1 = CInt(Mid(b, i, 1))
d = d + b1 * 2 ^ (n - i)
Next

bin2dec = d

End Function

お礼

おお！！かなり短いコードですね！！
自分で考えるとどうもたらたらと長ったらしく
なってしまっていたんですが、これならスッキリです。
ありがとうございました。

回答No.4

nda23

部分列の取り出しは他の方の回答を参照してください。
整数と文字列の変換は以下の方法が安直かと思います。

'★整数→２進文字列
Function Bin2Str(ByVal IntVal As Long) As String
Dim Obj
Set Obj = CreateObject("ScriptControl")
Obj.Language = "JScript"
Bin2Str = Obj.Eval("new Number(" & IntVal & ").toString(2);")
End Function
'★２進文字列→整数
Function Str2Bin(ByVal StrVal As String) As Long
Dim Obj
Set Obj = CreateObject("ScriptControl")
Obj.Language = "JScript"
Str2Bin = Obj.Eval("parseInt(""" & StrVal & """,2);")
End Function

以下の部分は共通なので、初期設定しておくと便利で、高速です。
Dim Obj
Set Obj = CreateObject("ScriptControl")
Obj.Language = "JScript"

尚、"toString(2)"やparseIntの",2"の"2"は２進数と言う意味で、
2～36まで指定できます。また、JScriptなので、Evalメソッドに渡す
文字列は大文字小文字を正確に使い分けてください。

お礼

個々に使っている関数はよくわかりませんが、手法は
かなり見た目が分かりやすくて、スッキリしていて
とても参考になりそうです！
ありがとうございました。

回答No.3

hotosys

こんなのはどうでしょうか？
1.
Private Function sample1(fileName As String, n As Integer) As String()
Dim res() As String
Dim buf() As String
Dim i As Integer
With CreateObject("Scripting.FileSystemObject").GetFile(fileName).OpenAsTextStream
buf = Split(.ReadAll, vbCrLf)
.Close
End With
ReDim res(UBound(buf) - 1)
For i = 0 To UBound(buf) - 1
res(i) = Split(buf(i), vbTab)(n)
Next
sample1 = res
End Function
2.
10進数を2進数
Private Function sample21(Value As Integer) As String
Dim ret As String
Dim bitp As Integer
Dim bit(-1 To 0) As String
bit(-1) = "0"
bit(0) = "1"
Do Until (Value < 2 ^ bitp)
ret = bit((Value And 2 ^ bitp) = 0) & ret
bitp = bitp + 1
Loop
sample21 = ret
End Function
その逆
Private Function sample22(Value As String) As Integer
Dim ret As Integer
Dim bit(-1 To 0) As Integer
Dim i As Integer
bit(-1) = 1
bit(0) = 0
For i = 1 To Len(Value)
ret = ret * 2 + bit(Mid(Value, i, 1) = "1")
Next
sample22 = ret
End Function

p.s.
sample1は最後がcrlfの場合です。

お礼

Filesystemobjectとかまだよく分からないのですが、
これを機に調べてみたいと思います。
ありがとうございました。

回答No.1

redfox63

Line Input #n, ss
などで1行取り込み InStrで ,を検索しながらどこから取り出すのかを決定

Function GetPart( s as String, n as Integer) as String
　　dim i as Integer
　　i = 1
　　do While n > 0
　　　　i = InStr( i, s, vbTab )
　　　　if i > 0 then
　　　　　　' ,が見つかった場合 次の検索開始位置の修正
　　　　　　i = i + 1
　　　　else
　　　　　　' 指定された個数以上の ,がなかった場合
　　　　　　GetPart = ""
　　　　　　Exit Function
　　　　end if
　　　　n = n - 1
　　loop
　　GetPart = Mid( ss, i )
End Function

お礼

ご回答ありがとうございます！！
そんなにコードは長くなくてもできるもんなんですね！
参考にさせていただきます。