[WinActor]CSV使ってVLOOKUP

yizm

5年前

業務アプリの入力インタフェースにおいて、コード入力のなんと多いことか！

なんでもサブウィンドウで検索させてコード解決しようとしよる。

そして、プロの皆さん気付けばコードを指が覚えてて迷わずタイピングできるという謎スキルを漏れなく獲得されてらっしゃる！！

さすがに、事前にリストが取得できるならいちいち検索したくないよね。

１．Excel関数のVLOOKUPみたいなことしてコード解決してみよう。

科目名から科目コードを引きたい、みたいな場合にサクッと使えるスクリプトステージです。

スクリプトステージのスクリプトタブに貼り付けます。

※ 2019/08/31 Update

従来のコードだと、項目の値にカンマが含まれるとうまく動かなかったんだけども、

splitExというすばらしいFunctionを公開されている記事を見つけたので組み込ませて頂きました。

Set dicColIdx = WScript.CreateObject("Scripting.Dictionary")
txtVal = Read_TEXT(!CSVファイル!)
lnTXT = split(txtVal, vbCrLf)
targetVal = !検索値!

Cols = Array(!キー項目名!, !取得項目名!)

HeaderRowCols = splitEx(lnTXT(0), NULL, NULL, NULL)
' 項目Indexを取得
For i=0 To UBound(Cols)
  For j=0 To UBound(HeaderRowCols)
    If HeaderRowCols(j) = Cols(i) Then
      dicColIdx.Add Cols(i), j
      Exit For
    End If
  Next
Next

' 項目値を判定して取得
Result = ""
For i=0 To UBound(lnTXT)
  ColVals = splitEx(lnTXT(i), NULL, NULL, NULL)
  If ColVals(dicColIdx(Cols(0))) = targetVal Then
    Result = ColVals(dicColIdx(Cols(1)))
    Exit For
  End If
Next

setUmsVariable $取得結果$ , Result

Function Read_TEXT(FilePath)
  Dim objFS, objTXT, Rslt
  Set objFS = CreateObject("Scripting.FileSystemObject")
  If objFS.FileExists(FilePath) Then
    Set objTXT = objFS.OpenTextFile(FilePath, 1)
    Rslt = objTXT.ReadAll()
    objTXT.close
    Set objTXT = Nothing
  Else
    Rslt = ""
  End If
  Set objFS = Nothing
  Read_TEXT = Rslt
End Function


' 引用: http://blog.livedoor.jp/tea_cocoa_cake/archives/5356742.html
'! Split()のテキスト区切り対応版
'! テキスト区切り文字(例CSVの")に対応した区切りを行う

'! @param   source        元文字列
'! @param   colDelim      列区切り文字(NULL可、NULLの場合「,」使用)
'! @param   lineDelim     行区切り文字(NULL可、NULLの場合vbCrLfを使用)
'! @param   textDelim     テキスト区切り文字(NULL可、NULLの場合「"」を使用) (textDelim2つでテキスト区切り文字エスケープ)
'! @return  1次元配列 (改行がある場合は配列要素としてvbNullChar単体が格納される
public function splitEx(source, colDelim, lineDelim, textDelim)
    splitEx = NULL
    dim textMode: textMode = False
    
    if (isNull(colDelim) ) Then
        colDelim = ","
    end if
    if (isNull(lineDelim) ) Then
        lineDelim = vbCrLf
    end if
    if (isNull(textDelim) ) Then
        textDelim = """"
    end if
    
    dim ab : set ab = New ArrayBuilder
    dim textBuf : textBuf = "" ' テキストバッファ
    dim char_i  : char_i = 1   ' 文字列のインデックス
    Do while (char_i <= len(source))
        dim curChar : curChar = getChar(source, char_i)
        
        if(textMode = True) Then
	        select case curChar
	        case textDelim
                '! 1文字先読み And エスケープ判定
                if ( getChar(source, char_i + 1) = textDelim ) Then
                    ' エスケープ
                    textBuf = textBuf & getChar(source, char_i + 1)
                    char_i = char_i + 1 ' 先読み分カウンタを加算
                else
                    ' テキストモードOFF
                    textMode = False
                end if
	        case Else
	            textBuf = textBuf & curChar
	        end select
        else
	        select case curChar
	        case colDelim
                ab.add textBuf
                textBuf = ""
	        case lineDelim
                ab.add textBuf
	            ab.add vbNullChar ' 改行を示す
                textBuf = ""
            case vbCr
                '! 1文字先読み And lineDelim=vbCrLf(※2文字)の場合の特殊な判定
                if ( getChar(source, char_i + 1) = vbLf And lineDelim = vbCrLf ) Then
	                ab.add textBuf
	                ab.add vbNullChar ' 改行を示す
	                textBuf = ""
	                char_i = char_i + 1 ' 先読み分カウンタを加算
	            else
	                textBuf = textBuf & curChar
                end if
	        case textDelim
                ' テキストモードON
                textMode = True
	        case Else
	            textBuf = textBuf & curChar
	        end select
        end if
        
        char_i = char_i + 1
    loop
    
    ' 最後にテキストバッファの残りを処理
    ab.add textBuf

    splitEx = ab.toArray()
end function


'! 文字列から1文字取得。文字列終端(VBScripでは通常参照しない)の場合ではvbNullChar(00)を返す
'! @param  source  元文字列
'! @param  index   文字列のインデックス
'! @return 文字
private function getChar(source, index)
    getChar = ""

    if (index <= 0 Or index > (len(source) + 1) ) Then
        err.raise 1025,,"範囲外の参照"
        exit function
    end if
    
    ' 文字列終端の場合
    if (index = (len(source) + 1) ) Then
        getChar = vbNullChar
    end if
    
    getChar = mid(source, index, 1)
end function


'! 配列生成
class ArrayBuilder
private my_lastIndex
private my_array()

Public Sub Class_Initialize
    dim INITIAL_SIZE : INITIAL_SIZE = 8
    my_lastIndex = -1
    redim Preserve my_array(INITIAL_SIZE - 1) ' 注意...配列は(指定サイズ + 1)のサイズで領域が確保される
End Sub

Public Sub Class_Terminate
End Sub

'! 値の参照
'! @param  index  配列インデックス
'! @return 値
public property get item(index)
    if (index < 0 Or index > my_lastIndex) Then
        err.raise 1025,,"範囲外の参照"
        exit property
    end if
    
    item = my_array(index)
end property

'! 値のセット
'! @param  index  配列インデックス
'! @param  value  値
public property let item(index, value)
    if (index < 0) Then
        err.raise 1025,,"範囲外の参照"
        exit property
    end if
    
    ' Expand
    Do While (index >= getSize() )
        call expand()
    Loop
    
    if (index > my_lastIndex) Then
        my_lastIndex    = index
    end if

    my_array(index) = value
end property

'! 最後尾に値の追加
'! @param  value  値
public sub add(value)
    me.item(my_lastIndex + 1) = value
end sub

'! 配列拡張
private sub expand()
    '+ wscript.echo "#Expanded!"
    ' 再確保のオーバヘッド軽減のため大きめにサイズを拡張
    redim Preserve my_array(getSize() * 2 - 1)
end sub

'! 配列サイズ取得
'! @return 現在の配列サイズ
private function getSize()
    '+ wscript.echo "#size:" & UBound(my_array) - LBound(my_array) + 1 
    getSize = UBound(my_array) - LBound(my_array) + 1 
end function

'! 要素に合わせて配列サイズを縮小
'! @param  arr  配列
'! @return 縮小後の配列
private function fit(ByRef arr)
    redim Preserve arr(my_lastIndex)
    fit = arr
end function

'! 配列を返す
'! @return 配列
public function toArray()
    dim tmpArray : tmpArray = my_array
    tmpArray = fit(tmpArray)
    toArray = tmpArray
end function

end class

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

Set dicColIdx = WScript.CreateObject("Scripting.Dictionary")

txtVal = Read_TEXT(!CSVファイル!)

lnTXT = split(txtVal, vbCrLf)

targetVal = !検索値!

Cols = Array(!キー項目名!, !取得項目名!)

HeaderRowCols = splitEx(lnTXT(0), NULL, NULL, NULL)

' 項目Indexを取得

For i=0 To UBound(Cols)

For j=0 To UBound(HeaderRowCols)

If HeaderRowCols(j) = Cols(i) Then

dicColIdx.Add Cols(i), j

Exit For

End If

' 項目値を判定して取得

Result = ""

For i=0 To UBound(lnTXT)

ColVals = splitEx(lnTXT(i), NULL, NULL, NULL)

If ColVals(dicColIdx(Cols(0))) = targetVal Then

Result = ColVals(dicColIdx(Cols(1)))

Exit For

End If

setUmsVariable $取得結果$ , Result

Function Read_TEXT(FilePath)

Dim objFS, objTXT, Rslt

Set objFS = CreateObject("Scripting.FileSystemObject")

If objFS.FileExists(FilePath) Then

Set objTXT = objFS.OpenTextFile(FilePath, 1)

Rslt = objTXT.ReadAll()

objTXT.close

Set objTXT = Nothing

Else

Rslt = ""

End If

Set objFS = Nothing

Read_TEXT = Rslt

End Function

' 引用: http://blog.livedoor.jp/tea_cocoa_cake/archives/5356742.html

'! Split()のテキスト区切り対応版

'! テキスト区切り文字(例CSVの")に対応した区切りを行う

'! @param source 元文字列

'! @param colDelim 列区切り文字(NULL可、NULLの場合「,」使用)

'! @param lineDelim 行区切り文字(NULL可、NULLの場合vbCrLfを使用)

'! @param textDelim テキスト区切り文字(NULL可、NULLの場合「"」を使用) (textDelim2つでテキスト区切り文字エスケープ)

'! @return 1次元配列 (改行がある場合は配列要素としてvbNullChar単体が格納される

public function splitEx(source, colDelim, lineDelim, textDelim)

splitEx = NULL

dim textMode: textMode = False

if (isNull(colDelim) ) Then

colDelim = ","

end if

if (isNull(lineDelim) ) Then

lineDelim = vbCrLf

end if

if (isNull(textDelim) ) Then

textDelim = """"

end if

dim ab : set ab = New ArrayBuilder

dim textBuf : textBuf = "" ' テキストバッファ

dim char_i : char_i = 1 ' 文字列のインデックス

Do while (char_i <= len(source))

dim curChar : curChar = getChar(source, char_i)

if(textMode = True) Then

select case curChar

case textDelim

'! 1文字先読み And エスケープ判定

if ( getChar(source, char_i + 1) = textDelim ) Then

' エスケープ

textBuf = textBuf & getChar(source, char_i + 1)

char_i = char_i + 1 ' 先読み分カウンタを加算

else

' テキストモードOFF

textMode = False

end if

case Else

textBuf = textBuf & curChar

end select

else

select case curChar

case colDelim

ab.add textBuf

textBuf = ""

case lineDelim

ab.add textBuf

ab.add vbNullChar ' 改行を示す

textBuf = ""

case vbCr

'! 1文字先読み And lineDelim=vbCrLf(※2文字)の場合の特殊な判定

if ( getChar(source, char_i + 1) = vbLf And lineDelim = vbCrLf ) Then

ab.add textBuf

ab.add vbNullChar ' 改行を示す

textBuf = ""

char_i = char_i + 1 ' 先読み分カウンタを加算

else

textBuf = textBuf & curChar

end if

case textDelim

' テキストモードON

textMode = True

case Else

textBuf = textBuf & curChar

end select

end if

char_i = char_i + 1

loop

' 最後にテキストバッファの残りを処理

ab.add textBuf

splitEx = ab.toArray()

end function

'! 文字列から1文字取得。文字列終端(VBScripでは通常参照しない)の場合ではvbNullChar(00)を返す

'! @param source 元文字列

'! @param index 文字列のインデックス

'! @return 文字

private function getChar(source, index)

getChar = ""

if (index <= 0 Or index > (len(source) + 1) ) Then

err.raise 1025,,"範囲外の参照"

exit function

end if

' 文字列終端の場合

if (index = (len(source) + 1) ) Then

getChar = vbNullChar

end if

getChar = mid(source, index, 1)

end function

'! 配列生成

class ArrayBuilder

private my_lastIndex

private my_array()

Public Sub Class_Initialize

dim INITIAL_SIZE : INITIAL_SIZE = 8

my_lastIndex = -1

redim Preserve my_array(INITIAL_SIZE - 1) ' 注意...配列は(指定サイズ + 1)のサイズで領域が確保される

End Sub

Public Sub Class_Terminate

End Sub

'! 値の参照

'! @param index 配列インデックス

'! @return 値

public property get item(index)

if (index < 0 Or index > my_lastIndex) Then

err.raise 1025,,"範囲外の参照"

exit property

end if

item = my_array(index)

end property

'! 値のセット

'! @param index 配列インデックス

'! @param value 値

public property let item(index, value)

if (index < 0) Then

err.raise 1025,,"範囲外の参照"

exit property

end if

' Expand

Do While (index >= getSize() )

call expand()

Loop

if (index > my_lastIndex) Then

my_lastIndex = index

end if

my_array(index) = value

end property

'! 最後尾に値の追加

'! @param value 値

public sub add(value)

me.item(my_lastIndex + 1) = value

end sub

'! 配列拡張

private sub expand()

'+ wscript.echo "#Expanded!"

' 再確保のオーバヘッド軽減のため大きめにサイズを拡張

redim Preserve my_array(getSize() * 2 - 1)

end sub

'! 配列サイズ取得

'! @return 現在の配列サイズ

private function getSize()

'+ wscript.echo "#size:" & UBound(my_array) - LBound(my_array) + 1

getSize = UBound(my_array) - LBound(my_array) + 1

end function

'! 要素に合わせて配列サイズを縮小

'! @param arr 配列

'! @return 縮小後の配列

private function fit(ByRef arr)

redim Preserve arr(my_lastIndex)

fit = arr

end function

'! 配列を返す

'! @return 配列

public function toArray()

dim tmpArray : tmpArray = my_array

tmpArray = fit(tmpArray)

toArray = tmpArray

end function

end class

２．設定タブはこんな感じ。

だいだい、好きな列で検索できるVLOOKUP関数だと思って頂ければよいと思います。

CSVファイル　⇒　参照するCSVファイルを指定
検索値　　　　⇒　検索値、キー項目名の列でマッチングする対象データ
キー項目名　　⇒　CSVヘッダの項目名で指定する。
取得項目名　　⇒　検索値がマッチした際に参照される項目をCSVヘッダの項目名で指定
取得結果　　　⇒　検索値が最初にマッチした行の取得項目列のデータが格納される。

１．Excel関数のVLOOKUPみたいなことしてコード解決してみよう。

２．設定タブはこんな感じ。

適用イメージ