| |
だるま さん、ｍ2ｍ10 さん ありがとうございます。
応用に苦労しています。
アドバイスを参考にして思いついたのですが
'日付を探索 をする際に
CSVファルの日付からシリアル値を得て
エクセル側の日付を探索、挿入するのが簡単そうなのですが
如何でしょうか
恐らくだるま さんは同様の事をアドバイスしてくれていると思うのですが
"D"の部分の数式が分からず応用がでていません。
実際下記マクロを使用しています。
Public Sub 商品()
Dim vntFileName As Variant
Dim dfn As Integer
Dim vntField As Variant
Dim strBuff As String
Dim lngCol As Long
Dim lngRow As Long
Dim rngScope As Range
Dim rngResult As Range
Dim rngDate As Range
Dim blnWayOut As Boolean
'「ファイルを開く」ダイアログを表示
Dim fileToOpen As Variant
ChDrive ""
ChDir ""
fileToOpen = Application.GetOpenFilename("テキスト ファイル (*.txt), *.txt")
Application.ScreenUpdating = False
'ActiveSheetのA1セルを基準とする（Listの左上隅）
Set rngResult = ActiveSheet.Cells(3, "A")
With rngResult
'日付の書かれている列数を取得
lngCol = .Offset(, 256 - .Column).End(xlToLeft).Column - .Column
'日付の有る範囲を取得
If lngCol = 0 Then
blnWayOut = True
GoTo WayOut
End If
'日付列の範囲を取得
Set rngDate = .Offset(, 1).Resize(, lngCol)
'No.が有る範囲を取得
Set rngScope = Range(.Offset(1), .Offset(65536 - .Row).End(xlUp))
End With
'指定されたファイルをOpen
dfn = FreeFile
Open fileToOpen For Input As dfn
'ファイルから日付を取得
Do Until EOF(dfn)
'ファイルから１行読み込み
Line Input #dfn, strBuff
'フィールドに分割
vntField = Split(strBuff, ",", , vbBinaryCompare)
'日付を探索
lngCol = GetDateColumn(vntField(0), rngDate, rngResult)
'No.を探索
lngRow = GetTagNoRow(vntField(2), rngScope, rngResult)
'日付、TagNoの交差するセルに値を書き込み
rngResult.Offset(lngRow, lngCol).Value = vntField(3)
Loop
Close #dfn
WayOut:
Set rngScope = Nothing
Set rngDate = Nothing
Set rngResult = Nothing
Application.ScreenUpdating = True
End Sub
|
|
mimi
- 05/8/1(月) 22:12 -
