Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


48488 / 76732 ←次へ | 前へ→

【33179】Re:外部ファイルの条件選択について
回答  Hirofumi  - 06/1/4(水) 17:32 -

引用なし
パスワード
   >これに今回ご提示頂いたマクロを組み込み、ダイアログによる選択を無くすには
>どのようにすればよいかが分かりません。
>
>ご指導をお願い致します。

1、まず、みりさんが、「- 06/1/4(水) 16:20 -」にUpされたコードと同じ標準モジュールに、
 「Private Function GetFilesList」をCopyします
2、ダイアログ表示はし無いので「Private Function GetReadFile」は削除します
3、以下のプロシージャは、其のまま使います
 「Function GetDateColumn」
 「Function GetTagNoRow」
 「Function DataSearch」
4、以下の様にコードを変更します

尚、データが無いのでTestはしておりませんので宜しく

Public Sub データ表示()

  '日付の先頭位置の前の列
  Const clngTop As Long = 13

  Dim strPath As String
  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 strProm As String
'  Dim strNoMatch As String '★削除
  Dim A As String
  Dim i As Long '◎追加
  Dim vntDate As Variant '◎追加

  'Textファイルの有るフォルダを指定
  strPath = "C:\list"

  '★以下の5行削除
'  '「ファイルを開く」ダイアログを表示
'  If Not GetReadFile(vntFileName, strPath, False) Then
'    strProm = "マクロがキャンセルされました"
'    GoTo Wayout
'  End If
  
  Application.ScreenUpdating = False

  'ActiveSheetのA1セルを基準とする
  Set rngResult = Worksheets("フォーマット").Cells(8, "A")
  With rngResult
    '抽出日付を取得(B3のセル位置) ◎追加
    vntDate = .Offset(-5, 1).Value '◎追加
    '日付の書かれている列数を取得
    lngCol = .Offset(, 256 - .Column).End(xlToLeft).Column _
            - .Offset(, clngTop).Column
    '日付列の範囲を取得
    If lngCol > 0 Then
      Set rngDate = .Offset(, clngTop + 1).Resize(, lngCol)
    Else
      strProm = "日付列が有りません。"
      GoTo Wayout
    End If
    'No.が有る行数を取得
    lngRow = .Offset(65536 - .Row).End(xlUp).Row - .Row
    'No.が有る範囲を取得
    If lngRow > 0 Then
      Set rngScope = .Offset(1).Resize(lngRow)
    End If
  End With

  'フォルダから指定日付のファイル名を取得 ◎追加
  If Not GetFilesList(vntFileName, strPath, vntDate) Then '◎追加
    strProm = "指定日付のファイルが有りません" '◎追加
    GoTo Wayout '◎追加
  End If '◎追加

  '取得したファイル名分繰り返し ◎追加
  For i = 1 To UBound(vntFileName) '◎追加
    '指定されたファイルをOpen
    dfn = FreeFile
    Open vntFileName(i) For Input As dfn '☆変更
    'ファイルEndまで繰り返し
    Do Until EOF(dfn)
      'ファイルから1行読み込み
      Line Input #dfn, strBuff
      'フィールドに分割
      vntField = Split(strBuff, ",", , vbBinaryCompare)
      '「20050731」形式の日付をシリアル値に変換
      vntField(0) = CLng(DateValue(Left(vntField(0), 4) _
                  & "/" & Mid(vntField(0), 5, 2) _
                  & "/" & Right(vntField(0), 2)))
      'No.を探索
      lngRow = GetTagNoRow(vntField(4), rngScope, rngResult)
      '行位置が見つかったら
      If lngRow > 0 Then
        '日付を探索
        lngCol = GetDateColumn(vntField(0), rngDate, _
                  rngResult.Offset(, clngTop)) + clngTop
        If lngCol = 0 + clngTop Then
          '該当日付が無い場合、メセージを出し直ちに終了する
          strProm = Format(vntField(0), "m/d") & " の日付が有りません。"
          Close #dfn '◎追加
          GoTo Wayout
        End If
        '日付、Noの交差するセルに値を書き込み
        With rngResult.Offset(lngRow, lngCol)
          .NumberFormatLocal = "G/標準"
          .Value = vntField(5)
        End With
        A = vntField(1)
        rngResult.Offset(2, lngCol).Value = Left(A, 2) & ":" & Right(A, 2)
      Else '◎追加
        '該当Itemが無い場合、メセージを出し直ちに終了する ◎追加
        strProm = vntField(4) & " のItemが有りません。" '◎追加
        Close #dfn '◎追加
        GoTo Wayout '◎追加
      End If
    Loop
    Close #dfn '◎追加
  Next i '◎追加
  
  '★以下の5行削除
'  If strNoMatch = "" Then
'    strProm = "処理が完了しました"
'  Else
'    strProm = "以下の該当しない日付がファイルに存在します" & vbCrLf & strNoMatch
'  End If
 
  strProm = "処理が完了しました" '◎追加
 
Wayout:

'  Close #dfn '★削除

  Application.ScreenUpdating = True

  Set rngScope = Nothing
  Set rngDate = Nothing
  Set rngResult = Nothing

'  Beep '★削除
  MsgBox strProm, vbInformation '☆変更

End Sub
2 hits

【33137】外部ファイルの条件選択について みり 06/1/3(火) 15:59 質問
【33138】Re:外部ファイルの条件選択について かみちゃん 06/1/3(火) 16:07 発言
【33139】Re:外部ファイルの条件選択について かみちゃん 06/1/3(火) 16:23 回答
【33157】Re:外部ファイルの条件選択について Hirofumi 06/1/3(火) 19:52 回答
【33174】Re:外部ファイルの条件選択について みり 06/1/4(水) 16:20 質問
【33179】Re:外部ファイルの条件選択について Hirofumi 06/1/4(水) 17:32 回答
【33184】Re:外部ファイルの条件選択について みり 06/1/4(水) 18:24 質問
【33188】Re:外部ファイルの条件選択について Hirofumi 06/1/4(水) 18:44 発言
【33196】Re:外部ファイルの条件選択について Hirofumi 06/1/4(水) 20:38 回答
【33198】Re:外部ファイルの条件選択について Hirofumi 06/1/4(水) 20:45 発言
【33297】Re:外部ファイルの条件選択について みり 06/1/7(土) 19:00 質問
【33298】Re:外部ファイルの条件選択について Hirofumi 06/1/7(土) 21:52 回答

48488 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free