| |
Hirofumi さん ほんとうにありがとうございます。
下記のように書き換えました。
質問があるのですが
lngCol = GetDateColumn(vntField(0), rngDate, rngResult) にて
コンパイルエラーが起こります。
sub または Functionが定義されていません。
"GetDateColumn"
どういうことなのでしょうか？
Public Sub 商品()
'日付の先頭位置（A列からのOffset値）
Const clngTop As Long = 3
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("")
Application.ScreenUpdating = False
'ActiveSheetのA1セルを基準とする（Listの左上隅）
Set rngResult = ActiveSheet.Cells(1, "A") '◎要変更？
With rngResult
'日付の書かれている列数を取得
lngCol = .Offset(, 256 - .Column).End(xlToLeft).Column _
- .Offset(, clngTop).Column + 1 '◎要変更？
'日付の有る範囲を取得
If lngCol = 0 Then
blnWayOut = True
GoTo WayOut
End If
'日付列の範囲を取得
Set rngDate = .Offset(, clngTop).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)
'日付を探索
vntField(0) = DateValue(Left(vntField(0), 4) & _
"/" & Mid(vntField(0), 5, 2) _
& "/" & Right(vntField(0), 2)) '★この行追加
lngCol = GetDateColumn(vntField(0), rngDate, rngResult) '← GetDateColumn
'No.を探索
lngRow = GetTagNoRow(vntField(1), rngScope, rngResult) '◎要変更？
'日付、TagNoの交差するセルに値を書き込み
rngResult.Offset(lngRow, lngCol).Value = vntField(2) '◎要変更？
Loop
Close #dfn
WayOut:
Set rngScope = Nothing
Set rngDate = Nothing
Set rngResult = Nothing
Application.ScreenUpdating = True
End Sub
|
|
mimi
- 05/8/4(木) 19:30 -
