こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

VBA でテキストファイルに読み書き

 エクセル2000のVBAを使用しています。
ブックAファイル名をブックBのセルに入力して、ブックAをインデックスの様な扱いのファイルを作成使用としたのですが、ブック間で変数のやり取りは出来ないと思います。できるんですか??
 その為、txtファイルを変数代わりに使おうと思っているのですが、
入出力の方法が良くわかりません。
 簡単にブックBのセルの値をtxtファイルに書き込んでブックAで、
そのtxtファイルを読み込む様なVBAのコード教えて下さい。
初心者ですけど・・。

投稿日時 - 2009-03-12 16:49:52

QNo.4790750

すぐに回答ほしいです

質問者が選んだベストアンサー

こんにちは。

補足の内容を拝見いたしました。

> そこでインデックスファイルを作成して、
> そこに受注番号、機種名、数量 等を自動入力させて
> 目次の様なファイルを作りたいと言う事です。
> 更に、ハイパーリンクを組み込み、クリック一発で
> 過去の受注ファイルを開く事が出来る様にしたいのです。
下記のコードは、関係企業から
「部品ごとに分けられたファイルのリストを作りたい」
との相談を受けて電話でのやりとりで作成したコードです。

質問者さんが意図した内容の処理に似てると思いましたので
コメントを読みながら処理の参考にしてみてください。

なお、私は現物のファイルも見ていませんし、現場にも出ていませんが、
ちゃんと目的の処理が実行されていると報告を受けています。

頭の中では、処理の内容が整理されていると思いましたので、
処理の手順を書き出して、その手順に従ってコードを組めば
意図した内容の処理ができると思います。
頑張ってください。

Sub Sample()

Dim OldSheetsCount As Long

Dim OpenFile As Variant, myBookName As String, _
  myPath As String, myFile As String, myFileName As String, _
  NewBook As Workbook, ListSht As Worksheet, _
  OpenBook As Workbook, OpenSht As Worksheet, _
  Target As Range, i As Long

'読み込むフォルダを指定する
OpenFile = Application.GetOpenFilename( _
  FileFilter:="エクセル ファイル (*.xls), *.xls", _
  Title:="部品コードのブックを一つ選択して[開く]をクリックしてください。", _
  MultiSelect:=False)

'キャンセルされたら終了
If OpenFile = False Then MsgBox "処理を中止します。": Exit Sub

'画面更新を止める
Application.ScreenUpdating = False

'キャンセルされなかったら処理を継続
'新規シートを一枚にセットして新規ブックを作る
With Application
  OldSheetsCount = .SheetsInNewWorkbook
  .SheetsInNewWorkbook = 1
  Set NewBook = .Workbooks.Add
  .SheetsInNewWorkbook = OldSheetsCount
End With

'記録用ワークシート
Set ListSht = NewBook.Worksheets(1)

'項目名の記入
With ListSht.Range("A1:C1")
  .Value = Array("部品コード", "型式名", "登録ブック名")
  .Interior.ColorIndex = 6
  .HorizontalAlignment = xlCenter
End With

'ウィンドウ枠の固定
Application.GoTo Reference:=ListSht.Range("A2")
ActiveWindow.FreezePanes = True

'このブック名
myBookName = ThisWorkbook.Name

'ドライブとパスの変更
myPath = Left(OpenFile, Len(OpenFile) - InStr(1, StrReverse(OpenFile), "\"))
ChDrive myPath
ChDir myPath

'Dir関数によりフォルダ内のすべてのブックに対して繰り返し
myFile = Dir("*.xls")
Do While myFile <> ""

  '自ブックでない時
  If myFile <> myBookName Then

    '読み取り専用で開く
    Set OpenBook = Workbooks.Open(Filename:=myFile, ReadOnly:=True)

    '開いたブックの最初のシート
    Set OpenSht = OpenBook.Worksheets(1)

    With ListSht

      'シートから"型式名"を探す
      On Error Resume Next
      Set Target = OpenSht.Cells.Find(What:="型式名", _
        After:=OpenSht.Range("A1"), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows)
      On Error GoTo 0

      '"型式名"があったら
      If Not Target Is Nothing Then

        'カウンタリセット
        i = 1
        Do

          'すべての型式名を取得してシートに書き込む
          With .Range("B" & .Rows.Count).End(xlUp).Offset(1)
            .NumberFormat = "@"
            .Value = Target.Offset(i).Value
          End With

          'ハイパーリンクを設定する
          .Hyperlinks.Add _
            Anchor:=.Range("C" & .Rows.Count).End(xlUp).Offset(1), _
            Address:=OpenBook.FullName, TextToDisplay:=OpenBook.Name

          'カウンタ加算
          i = i + 1

        Loop Until Target.Offset(i).Value = ""

        'ブック名を部品コードとしてシートに書き込む
        With .Range("A" & .Rows.Count).End(xlUp).Offset(1).Resize(i - 1)
          .NumberFormat = "@"
          .Value = Replace(myFile, ".xls", "")
        End With

      End If
    End With

    '開いたブックを閉じる
    OpenBook.Close Savechanges:=False
    Set OpenSht = Nothing
    Set OpenBook = Nothing

  End If

  '次のブック
  myFile = Dir()

Loop
'↑ここまで繰り返し

'アクティブセル領域に対し、列幅自動調整、部品コード順に並べ替え
With ListSht.Range("A1").CurrentRegion

  .EntireColumn.AutoFit
  .Sort Key1:=.Parent.Parent.Parent.Range("A2"), Order1:=xlAscending, _
    Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom, SortMethod:=xlPinYin

  'もし書き込みデータがなかったらブックを閉じる
  If .Cells.Count = 3 Then
    Application.DisplayAlerts = False
    NewBook.Close Savechanges:=False
    Application.DisplayAlerts = True
  End If

End With

'シート名を現在の日付& 時刻にする
ListSht.Name = Format(Now, "yyyy年mm月dd日hh時mm分ss秒")

'画面更新を有効
Application.ScreenUpdating = True

Set ListSht = Nothing
Set NewBook = Nothing

End Sub

投稿日時 - 2009-03-14 20:33:15

お礼

有り難うございました。
非常に参考になり、思った事が
実現しました。
本当に有り難うございました。

投稿日時 - 2009-03-25 11:46:09

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.2

であればこんな感じ?

INDEXファイルを Index.xls と仮定し、記入するのはIndex.xlsのSheet(1)のA列に順に記載してゆくものと決め打ちにしています。
また、Index.xlsとデータファイルは同じフォルダ内にあるものと仮定しています。
フォルダが違う場合には、ThisWorkbook.Path を利用している部分を修正する必要があります。

Function Registは、bName(=登録しようとするファイル名)が既にあるかをチェックし、新規登録を行った場合はTrue、既に登録済で何もしなかった場合はFalseを返します。
(常に新規登録しか起こり得ないのであれば、登録済みかをチェックする必要もありませんので、かなり処理をはぶくことが可能です。)

Function Regist(bName As String) As Boolean
Dim wb As Workbook, c As Range
Dim rw As Long, bPath As String
Const index = "Index.xls" '// INDEXファイルのファイル名

Application.ScreenUpdating = False '// 必要に応じて表示をOFF
bPath = ThisWorkbook.Path & "\"
Set wb = Workbooks.Open(bPath & index)
wb.Worksheets(1).Activate
rw = Cells(Rows.Count, 1).End(xlUp).Row
Set c = Nothing

If (rw = 1) And (Cells(1, 1) = "") Then  '//1行目も未記入(新規シート)
rw = 0
Else
'// 同じブック名が既にあるかをチェック
Set c = Range("A1:A" & rw).Find(bName, LookIn:=xlValues, LookAt:=xlWhole)
End If
If c Is Nothing Then '// リンクを登録
ActiveSheet.Hyperlinks.Add Anchor:=Cells(rw + 1, 1), _
Address:=bPath & bName, TextToDisplay:=bName
Regist = True
Else
Regist = False
End If

Application.DisplayAlerts = False '// 保存時の確認メッセージを回避
wb.Close (Regist)
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Function

投稿日時 - 2009-03-13 13:24:15

お礼

有り難うございました。
非常に参考になり、
予定していた事が実現しました。

ありがとうございました。

投稿日時 - 2009-03-25 11:47:36

ANo.1

>ブック間で変数のやり取りは出来ないと思います。できるんですか??
変数のやり取りというより、データの記入でよいのですよね?できますよ。

具体的に何をやりたいのか、いまひとつよくわかりませんので、以下、簡単なサンプル。
新しいブックを作成して、そのブックのシート1のA1に、自分のブック名を書き込むというものです。

セルやレンジを指定するときには、きちんと識別できるように
 Workbook.WorkSheet.Range の形で指定してあげる必要があります。

Sub test()
Dim filename As String
Dim wb As Workbook

filename = ThisWorkbook.Name
Set wb = Workbooks.Add
wb.Sheets(1).Cells(1, 1).Value = filename
End Sub

テキストファイルの読み書きも当然できますが、↑でもお望みのことができるのではないでしょうか?

投稿日時 - 2009-03-12 17:44:02

補足

> ありがとうございました。
 でも、私の説明の仕方が少し、良くなかった様なので再度説明します。

 私は製造業の課長ですが、我々の生産は受注生産で
多くの機種が受注番号を付けられ、我々のところに来て
生産が行われます。

製造課に於いては、1つの受注オーダーに於いて、1つのエクセルファイルを作ります。
その中に生産時の情報が記録として、入力されます。(1オーダー、1ファイル))

そのファイルのセルA1には、受注番号を入力しますので
A1の受注番号を利用して、そのファイル自身に名前を付けて保存します。
ここまでは自分でマクロ組みました。

この様にしていくと、1ヶ月にかなりの数のファイルが出来ます。
(受注の数だけ出来る事になる。)

そこでインデックスファイルを作成して、
そこに受注番号、機種名、数量 等を自動入力させて
目次の様なファイルを作りたいと言う事です。
更に、ハイパーリンクを組み込み、クリック一発で
過去の受注ファイルを開く事が出来る様にしたいのです。
(ちなみに過去の受注ファイルは、生産終了後、たびたび使用する為)

製品によっては、日をまたいで生産する製品もあるし、
又、半分だけ生産して、一週間後に再開する製品もあります。
その為、受注ファイルが名前を付けて保存する時に
同時にINDEXファイルにも登録したいのです。 
そうすれば、翌日、または一週間後にも、INDEXファイルから
簡単に開く事が可能になるからです。

 新規に作成した受注ファイルは、その度に名前が変わる事になる為
名前を付けて保存する際にファイル名を変数に代入しました。
 その後、自動でINDEXファイルを開き、OPENイベントで
変数を指定のセルに入力しようとしたんですが、だめでした。

 ちなみ、上記のコード、今からチャレンジしてみます。

投稿日時 - 2009-03-13 08:18:43

あなたにオススメの質問