|
もうTestデータも削除してしまっているのでTest出来ませんが
以下を変更すれば善いと思います
1、「Public Sub CrossTabulation」の中で以下の様に変更
' '日付を探索
' lngCol = GetDateColumn(vntField(0), rngDate, _
' rngResult.Offset(, clngTop)) + clngTop
' 'No.を探索
' lngRow = GetTagNoRow(vntField(5), rngScope, rngResult)
' '日付、Noの交差するセルに値を書き込み
' With rngResult.Offset(lngRow, lngCol)
' .NumberFormatLocal = "G/標準"
' .Value = vntField(6)
' End With
' Loop
〜
'No.を探索
lngRow = GetTagNoRow(vntField(5), rngScope, rngResult)
'行位置が見つかったら
If lngRow > 0 Then
'日付を探索
lngCol = GetDateColumn(vntField(0), rngDate, _
rngResult.Offset(, clngTop)) + clngTop
'日付、Noの交差するセルに値を書き込み
With rngResult.Offset(lngRow, lngCol)
.NumberFormatLocal = "G/標準"
.Value = vntField(6)
End With
End If
Loop
2、「Private Function GetTagNoRow」を以下の様に変更
'★プロシージャ変更
Private Function GetTagNoRow(vntTagNo As Variant, _
rngScope As Range, _
rngListTop As Range) As Long
Dim lngFound As Variant
'No範囲にNoが無いなら
If rngScope Is Nothing Then
lngFound = 0
Else
'Noを探索
lngFound = DataSearch(CLng(vntTagNo), rngScope, , 0)
End If
'位置を返す
GetTagNoRow = lngFound
End Function
PS:
全文のUpは、全文のUpが如何しても必要な場合だけにした方が善いですよ
|
|