Excel VBA 基本操作

Excel VBA のトップに戻る
Excel VBA 目次

日本語変数と、Excelの計算式を記述
OSのバージョンとExcelのバージョンを取得
データを並び替え
大量データを照合
ソートして順位(ランク)を設定
二次元配列ソート(Access データベースをシーケンシャルに更新する)
連想配列を使って検索を高速化する
 ・Dictionary オブジェクトと Collection オブジェクト

索引

日本語変数と、Excelの計算式を記述

 VBA の変数名には、日本語が使えます。変数を日本語にしておくと、関数やコマンドとの区分が容易で、マクロ記述が格段に判読しやすくなります。コメントをそれほど挿入しなくても、プログラムがどんな処理をしているか、理解できるでしょう。
 キー入力時に、半角英数と、日本語を頻繁に切替えるときは、ホーム・ポジションから手を動かさなくてもよいように、[無変換]キーを左親指で押す方法を使うと、スムーズに切替えできます。

 下のマクロは、計算を、VBA で処理する方法と、Excel の計算式を VBA で記述する方法の、2つを対比した例です。
 一般に、VBA で計算してしまう方が、マクロの記述は簡単で、Excel も重たくなりません。このため、Excel の計算式を VBA で記述するのは、Excelシートで、部分修正して再計算したいなど、明確な目的がある場合に限られるでしょう。

 このマクロをダウンロードできます。→money.xls
金額 = 単価 * 数量

Option Explicit

Sub 金額計算()
    Dim 単価 As Double
    Dim 数量 As Long
    Dim 最終行 As Integer
    Dim 合計金額 As Double
    Dim i As Integer
    
    最終行 = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

    'VBAで計算(D列)
    合計金額 = 0
    For i = 2 To 最終行
        単価 = Range("A1").Cells(i, 2).Value
        数量 = Range("A1").Cells(i, 3).Value
        Range("A1").Cells(i, 4).Value = 単価 * 数量
        合計金額 = 合計金額 + 単価 * 数量
    Next i
    
    'Excelの計算式を使う(E列)
    Range("E2").Formula = "=B2*C2"
    Range("E2").Copy Destination _
    :=Range("E3").Resize(最終行 - 2, 1)

'合計金額

    'VBAで計算(D列)
    Range("A1").Cells(i, 3).Value = "合計金額"
    Range("A1").Cells(i, 4).Value = 合計金額

    'Excelの計算式を使う(E列)
    Range("E2").Cells(最終行, 1).Formula _
    = "=SUM(E2:E" & 最終行 & ")"

'    Columns("B:E").Select
'    Selection.NumberFormat = "#,##0_ ;[赤]-#,##0 "

    Cells.Select                   'セル全体を選択して、
    Selection.Style = "Comma [0]"  'コンマ区切りにする。
    Cells.EntireColumn.AutoFit     '列幅を自動調整

    Range("A1").Select

End Sub

 解説:
 変数名には、文字 (英数字、漢字、ひらがな、カタカナ) とアンダスコア (_) を使うことができます。スペースや記号は使えません。変数名の先頭の文字には、数字とアンダスコア (_) は使えません。変数名の長さは、半角で 255 文字以内でなければなりません。

 Formula プロパティを Range オブジェクトに指定した場合は、オブジェクトの数式を、A1 形式の表記形式で、コード記述時の言語で設定します。値の取得および設定が可能です。バリアント型 (Variant) の値を使用します。

 FormulaLocal プロパティは、コード実行時の言語で設定します。


 EntireColumn プロパティは、オブジェクトを返すプロパティです。指定されたセル範囲を含む 1 列または複数の列全体 (Range オブジェクト) を返します。値の取得のみ可能です。

使用例
次の使用例は、アクティブ セルを含む列の先頭セルに値を設定します。この使用例は、ワーク シートから実行してください。

ActiveCell.EntireColumn.Cells(1, 1).Value = 5

 AutoFit メソッドは、対象セル範囲の列の幅や行の高さを内容に合わせて調節します。
 expression.AutoFit
 expression 必ず指定します。対象となる Range オブジェクトを返すオブジェクト式を指定します。サイズを調節するセル範囲を指定します。1 行または行の範囲、あるいは 1 列または列の範囲を指定する必要があります。それ以外の選択範囲に対してこのメソッドを使うと、エラーが発生します。

 Resize プロパティは、直前の Range で指定したセルに対して、サイズを変更したセル範囲 (Range オブジェクト) を返します。
 expression.Resize(RowSize, ColumnSize)

 expression 必ず指定します。サイズを変更する Range オブジェクトを返すオブジェクト式を指定します。
 RowSize ColumnSize 新しい範囲の行数と列数をそれぞれ指定します。この引数は、正数でないとエラーになります。

 上の例では、Resize プロパティを使って、数値で動的に、Range("E3")を左上端とする矩形のセル範囲を指定しています。

この種類の目次に戻る↑ 索引へ↓ トップページに戻る

OSのバージョンとExcelのバージョンを取得

Win OSのバージョン
Windowsのバージョン
 下記を表示させます。
2000 :5.00
XP   :5.01
Vista:6.00
7    :6.01
8    :6.02

Excel 2003 :11.0
Excel 2007 :12.0
Excel 2010 :14.0
Excel 2013 :15.0

Word 2002→10.0
Word 2003→11.0
Word 2007→12.0
Word 2010→14.0 ←13は忌み嫌われた数で欠番?

 IE のバージョンを取得も、参照して下さい。


Sub OSのバージョンとExcelのバージョン取得()

   Dim OS名 As String
   Dim Excelバージョン As String

    OS名 = Application.OperatingSystem
    
    Excelバージョン = Application.Version

    MsgBox "OS名:" & OS名 & vbCrLf _
            & "Excelバージョン:" & Excelバージョン
            
'            2000 :5.00
'            XP   :5.01
'            Vista:6.00

'            2003 :11.0
'            2007 :12.0
End Sub

 解説:
 OperatingSystem プロパティは、現在のオペレーティング システムの名前とバージョンを返します。たとえば、Windows (32 ビット) 4.00 や Macintosh 7.00 を返します。値の取得のみ可能です。文字列型 (String) の値を使用します。

 OS が 32ビット版か、64ビット版かの判断を、下記のコードでできるかと思ったのですが、ダメでした。
   OSビット数 = Mid(Application.OperatingSystem, InStr(Application.OperatingSystem, "(") + 1, 2)

ググって見たら、WMI Fun !! のサイトで、下記のコードを公開していただいていました。
http://www.wmifun.net/sample/win32_operatingsystem_f.html
http://www.wmifun.net/library/win32_operatingsystem.html
Sub OSのビットバージョン取得()

   'WMIにて使用する各種オブジェクトを定義・生成する。
   Dim oClassSet
   Dim oClass
   Dim oLocator
   Dim oService
   Dim sMesStr

   'ローカルコンピュータに接続する。
   Set oLocator = CreateObject("WbemScripting.SWbemLocator")
   Set oService = oLocator.ConnectServer
   'クエリー条件をWQLにて指定する。
   Set oClassSet = oService.ExecQuery("Select * From Win32_OperatingSystem")

   'コレクションを解析する。
   For Each oClass In oClassSet
      sMesStr = sMesStr & CStr(oClass.OSArchitecture)
   Next

   MsgBox Left(sMesStr, 2)

   '使用した各種オブジェクトを後片付けする。
   Set oClassSet = Nothing
   Set oClass = Nothing
   Set oService = Nothing
   Set oLocator = Nothing

End Sub
 上のコードは、WMI Fun !!管理人 Toh さんのご了解をいただいて転載しています。

 WMI Fun !! は、WMI の紹介サイトです。
 WMI (Windows Management Instrumentation) は、システムに関する情報を簡単に取り出せるツールで、WMI を使うと、このように、端末情報を取得できるのですね。


 Version プロパティApplication オブジェクトに指定した場合、Excel のバージョン番号を返します。値の取得のみ可能です。文字列型 (String) の値を使用します。

この種類の目次に戻る↑ 索引へ↓ トップページに戻る


データを並び替え

 データが、Excelの行の数以内なら、Excelの Sort メソッド が使えます。
 しかし、これ以上のデータ件数をソートしたい場合は、一般的なソーソ・ルーチンを使います。下は、「クイックソート」と呼ばれるものです。

 下のコードは、よねさんのWordとExcelの小部屋
 Excel(エクセル) VBA入門:配列の並べ替え
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_array2.html
を、変数名を漢字に変更して、転載させていただきました。

 いろいろなソートアルゴリズム★←ソートの過程を動画で理解できます!
http://www.ics.kagoshima-u.ac.jp/~fuchida/edu/algorithm/sort-algorithm/top.html


Private Sub クイックソート(ByRef 配列() As Variant, ByVal 配列要素下限 As Long, ByVal 配列要素上限 As Long)
    Dim i As Long
    Dim j As Long
    Dim S As Variant
    Dim Tmp As Variant
        S = 配列(Int((配列要素下限 + 配列要素上限) / 2))
        i = 配列要素下限
        j = 配列要素上限
        Do
            Do While 配列(i) < S
                i = i + 1
            Loop
            Do While 配列(j) > S
                j = j - 1
            Loop
            If i >= j Then Exit Do
            Tmp = 配列(i)
            配列(i) = 配列(j)
            配列(j) = Tmp
            i = i + 1
            j = j - 1
      Loop
      If (配列要素下限 < i - 1) Then Call クイックソート(配列, 配列要素下限, i - 1)
      If (配列要素上限 > j + 1) Then Call クイックソート(配列, j + 1, 配列要素上限)
End Sub

この種類の目次に戻る↑ 索引へ↓ トップページに戻る


大量データを照合

 複数のファイルを照合するとき、数が少ないときは、繰返し処理で照合します。
(参考→Excel関数の VLOOKUP をマクロで)

 しかし、件数が多くなると、その処理回数は、掛け算になるので、当然時間がかかります。
 例えば、100万件のデータと、20万件のデータを、「繰返し処理」で照合すると、その回数は、
100万件×20万件/2=1,000億回
にもなります。

 このようなときの、照合作業の速度を上げる方法を、二つ紹介します。
1.それぞれのデータを、前もって、照合キーで並べておいて、二つの歯車を噛み合わせるように、順次処理で照合する。
2.「連想配列」を使って照合のキーの索引を作成し、キー参照して直接照合する。←私の推奨

 ふたつとも、その速度が、飛躍的に改善されて、感激しました。

 下のマクロは、マスタとワーク(トランザクション)を、「郵便番号」をキーとして照合して、ワークに存在したデータを、マスタの属性情報として追記しています。
(このサンプルには、業務的な意味は有りません。)
単純照合の処理時間   :01分31秒
ソートして照合の処理時間:00分05秒
連想配列で照合の処理時間:00分05秒
 進捗状況が、Excelの左下のステータスバーに表示されます。

 この例のマクロとサンプル・データを、ダウンロードできます。
マクロ:matchingVBA03.xls
マスタファイル(2009年の郵便番号データ)ZipCode2009.zip(122,874件)
ワークファイル(2007年と2009年の追加差分データ)ADD0702_0902.zip(2,237件)
データの例として、郵便番号ダウンロードを使いました。

注:キーが数値の場合は、マスタとトランザクション(ワーク)の形式を合わせること!

 キーが数値の場合、固定長でソートしたときと、可変長でソートしたときでは、その並び順が変わります。
 例:
数値を固定長(頭に空白追加) = 35,77,134,407,515,554,614,735,809
数値を可変長(前詰めのまま) = 134,35,407,515,554,614,735,77,809

 このため、照合キーが数値の場合は、照合するそれぞれのファイルのキーの登録方法が違っていると、前後関係が変わってしまい、順次処理で突き合わせ、できません。
 配列に登録する時点で、キー部分の桁数の処理方法を、固定長か可変長かのどちらか一方に、統一します。


Option Explicit
Option Base 1

   Dim 開始日時 As Variant
   Dim 終了日時 As Variant
   Dim ファイルシステムオブジェクト As Object           ' FileSystemObject
   Dim 入力テキストストリームオブジェクト As Object
   Dim 出力テキストストリームオブジェクト As Object
   Dim 現在のパス As String
   Dim 処理内容 As String
   Dim 入力ファイル名 As String
   Dim 出力ファイル名 As String
   Dim 照合結果ファイル名 As String
   Dim 入力件数 As Long
   Dim 入力行 As String
   Dim 出力行 As String

   Dim マスタファイル名 As String
   Dim ワークファイル名 As String
   Dim 区切り文字 As String
   Dim 区切り位置1 As Integer
   Dim 区切り位置2 As Integer
   Dim マスタ配列() As Variant
   Dim マスタ件数 As Long
   Dim ワーク配列() As Variant
   Dim ワーク件数 As Long
   Dim 郵便番号 As String
   Dim ケンメイ As String
   Dim 検索行 As Long
   Dim 処理行 As Long
   Dim 検索開始行 As Long
   Dim 合致件数 As Long
   Dim 合致 As String
   
'************★★★ 単純照合 ★★★********************
Sub 単純照合()

    開始日時 = Now()
   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")

   Call マスタファイル読み込み
   
   Call ワークファイル読み込み

   Call 繰返し参照して出力
   
終了処理:
   Set ファイルシステムオブジェクト = Nothing
   ThisWorkbook.Worksheets("Sheet1").Activate

   終了日時 = Now()
   Range("B8").Value = Format(終了日時 - 開始日時, "hh時間nn分ss秒")
   Application.StatusBar = "☆★処理終了しました!処理時間:" _
& Format(終了日時 - 開始日時, "hh時間nn分ss秒") & " ★☆"
   MsgBox "処理が終了しました。" & Chr(13) & "処理時間は、" _
& Format(終了日時 - 開始日時, "hh時間nn分ss秒") & " でした。", vbOKOnly

End Sub


'************★★★ ソートして照合 ★★★********************
Sub ソートして照合()

    開始日時 = Now()
   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")

   Call マスタファイル読み込み
'Stop
   処理内容 = "マスタ・ファイルを並び替え"
   Application.StatusBar = "☆★☆" & 処理内容 & "☆★☆"
   Call クイックソート(マスタ配列, 1, マスタ件数)

   Call ワークファイル読み込み

   処理内容 = "ワーク・ファイルを並び替え"
   Application.StatusBar = "☆★☆" & 処理内容 & "☆★☆"
   Call クイックソート(ワーク配列, 1, ワーク件数)

   Call かみ合わせ照合して出力
   
終了処理:
   Set ファイルシステムオブジェクト = Nothing
   ThisWorkbook.Worksheets("Sheet1").Activate

   終了日時 = Now()
   Range("B9").Value = Format(終了日時 - 開始日時, "hh時間nn分ss秒")
   Application.StatusBar = "☆★処理終了しました!処理時間:" _
& Format(終了日時 - 開始日時, "hh時間nn分ss秒") & " ★☆"
   MsgBox "処理が終了しました。" & Chr(13) & "処理時間は、" _
& Format(終了日時 - 開始日時, "hh時間nn分ss秒") & " でした。", vbOKOnly

End Sub


'************★★★ 連想配列 ★★★********************
Sub 連想配列()

    開始日時 = Now()
   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")

   Call マスタファイル読み込み
   
   Call ワークファイル読み込み

   Call 連想配列でキー参照して出力
   
終了処理:
   Set ファイルシステムオブジェクト = Nothing
   ThisWorkbook.Worksheets("Sheet1").Activate

   終了日時 = Now()
   Range("B10").Value = Format(終了日時 - 開始日時, "hh時間nn分ss秒")
   Application.StatusBar = "☆★処理終了しました!処理時間:" & Format(終了日時 - 開始日時, "hh時間nn分ss秒") & " ★☆"
   MsgBox "処理が終了しました。" & Chr(13) & "処理時間は、" & Format(終了日時 - 開始日時, "hh時間nn分ss秒") & " でした。", vbOKOnly

End Sub


'********************************************************
Private Sub 連想配列でキー参照して出力()

   Dim ワーク索引 As Object        'Scripting.Dictionary オブジェクト
   Dim ワーク配列添え字 As Integer 'Scripting.Dictionary オブジェクトのデータ

   現在のパス = ActiveWorkbook.Path
   処理内容 = "連想配列でキー参照して出力"
   
   '★ワーク索引を作成★
   Set ワーク索引 = CreateObject("Scripting.Dictionary")  '★連想配列の定義
   For 処理行 = 1 To ワーク件数
      入力行 = ワーク配列(処理行)
      郵便番号 = Mid(入力行, 2, 7)
      ワーク索引(郵便番号) = 処理行
   Next 処理行

   出力ファイル名 = "連想配列でキー参照して出力.txt"
   照合結果ファイル名 = 現在のパス & "\" & 出力ファイル名
   ' 指定ファイルをOPEN(出力モード)
   Set 出力テキストストリームオブジェクト = _
   ファイルシステムオブジェクト.CreateTextFile(照合結果ファイル名)
   
   合致件数 = 0
   区切り文字 = Chr(34) & "," & Chr(34) '","

   For 処理行 = 1 To マスタ件数
      合致 = ""
      入力行 = マスタ配列(処理行)

      If (処理行 Mod 1000) = 0 Then
         Application.StatusBar = "☆" & 処理行 & " 行目を読込み☆ " & 処理内容
      ElseIf (処理行 Mod 500) = 0 Then
         Application.StatusBar = "★" & 処理行 & " 行目を読込み★ " & 処理内容
      End If
      
'      読み込み行文字数 = Len(入力行)
      郵便番号 = Mid(入力行, 2, 7)

      If ワーク索引.Exists(郵便番号) = True Then
         '★郵便番号が存在した場合
         ワーク配列添え字 = ワーク索引(郵便番号)

         区切り位置1 = InStr(ワーク配列(ワーク配列添え字), 区切り文字)
         区切り位置2 = InStr(区切り位置1 + 1, ワーク配列(ワーク配列添え字), 区切り文字)
         
         ケンメイ = Mid(ワーク配列(ワーク配列添え字), 区切り位置1 + 3, 区切り位置2 - 区切り位置1 - 3)
'            Stop
         出力行 = 入力行 & "," & Chr(34) & "★" & 区切り文字 & ケンメイ & Chr(34)
         合致件数 = 合致件数 + 1
      Else 'ワークデータが存在しない場合は、既存のまま出力
         出力行 = 入力行
      End If
      
      出力テキストストリームオブジェクト.WriteLine 出力行         ' 改行(CrLf)付き

   Next 処理行
   
   ' 指定ファイルをClose(出力モード)
   出力テキストストリームオブジェクト.Close
   Set 出力テキストストリームオブジェクト = Nothing

   ThisWorkbook.Worksheets("Sheet1").Activate
    Range("B7").Value = 合致件数
   
End Sub


'********************************************************
Private Sub 繰返し参照して出力()

   現在のパス = ActiveWorkbook.Path
   処理内容 = "繰返し参照して出力"
   
   出力ファイル名 = "繰返し参照結果.txt"
   照合結果ファイル名 = 現在のパス & "\" & 出力ファイル名
   ' 指定ファイルをOPEN(出力モード)
   Set 出力テキストストリームオブジェクト = _
   ファイルシステムオブジェクト.CreateTextFile(照合結果ファイル名)
   
   合致件数 = 0
   検索開始行 = 1
   区切り文字 = Chr(34) & "," & Chr(34) '","

   For 処理行 = 1 To マスタ件数
      合致 = ""
      入力行 = マスタ配列(処理行)

      If (処理行 Mod 10000) = 0 Then
         Application.StatusBar = "☆" & 処理行 & " 行目を読込み☆ " & 処理内容
      ElseIf (処理行 Mod 5000) = 0 Then
         Application.StatusBar = "★" & 処理行 & " 行目を読込み★ " & 処理内容
      End If
      
'      読み込み行文字数 = Len(入力行)
      郵便番号 = Mid(入力行, 2, 7)

      For 検索行 = 1 To UBound(ワーク配列) 'ソートされていないので、常に最初から照合が必要
         If 郵便番号 = Mid(ワーク配列(検索行), 2, 7) Then
            区切り位置1 = InStr(ワーク配列(検索行), 区切り文字)
            区切り位置2 = InStr(区切り位置1 + 1, ワーク配列(検索行), 区切り文字)
            
            ケンメイ = Mid(ワーク配列(検索行), 区切り位置1 + 3, 区切り位置2 - 区切り位置1 - 3)
'            Stop
            出力行 = 入力行 & "," & Chr(34) & "★" & 区切り文字 & ケンメイ & Chr(34)
            検索開始行 = 検索行
            合致件数 = 合致件数 + 1
            合致 = "合致"
            Exit For
         End If
      Next 検索行
      If 合致 = "" Then
         出力行 = 入力行
      End If
      
      出力テキストストリームオブジェクト.WriteLine 出力行         ' 改行(CrLf)付き

   Next 処理行
   
   ' 指定ファイルをClose(出力モード)
   出力テキストストリームオブジェクト.Close
   Set 出力テキストストリームオブジェクト = Nothing

   ThisWorkbook.Worksheets("Sheet1").Activate
    Range("B7").Value = 合致件数
   
End Sub


'********************************************************
Private Sub かみ合わせ照合して出力()

   現在のパス = ActiveWorkbook.Path
   処理内容 = "かみ合わせ照合して出力"
   
   出力ファイル名 = "かみ合わせ照合結果.txt"
   照合結果ファイル名 = 現在のパス & "\" & 出力ファイル名
   ' 指定ファイルをOPEN(出力モード)
   Set 出力テキストストリームオブジェクト = _
   ファイルシステムオブジェクト.CreateTextFile(照合結果ファイル名)
   
   合致件数 = 0
   検索開始行 = 1
   
   区切り文字 = Chr(34) & "," & Chr(34) '","

   For 処理行 = 1 To マスタ件数
      合致 = ""
      入力行 = マスタ配列(処理行)

      If (処理行 Mod 10000) = 0 Then
         Application.StatusBar = "☆" & 処理行 & " 行目を読込み☆ " & 処理内容
      ElseIf (処理行 Mod 5000) = 0 Then
         Application.StatusBar = "★" & 処理行 & " 行目を読込み★ " & 処理内容
      End If
      
'      読み込み行文字数 = Len(入力行)
      郵便番号 = Mid(入力行, 2, 7)

      For 検索行 = 検索開始行 To UBound(ワーク配列) '検索はキーが一致したところから始める
         If 郵便番号 < Mid(ワーク配列(検索行), 2, 7) Then
            検索開始行 = 検索行 'ソートされているので、行き過ぎた時点で照合をパス
            Exit For
         ElseIf 郵便番号 = Mid(ワーク配列(検索行), 2, 7) Then
            区切り位置1 = InStr(ワーク配列(検索行), 区切り文字)
            区切り位置2 = InStr(区切り位置1 + 1, ワーク配列(検索行), 区切り文字)
            
            ケンメイ = Mid(ワーク配列(検索行), 区切り位置1 + 3, 区切り位置2 - 区切り位置1 - 3)
            出力行 = 入力行 & "," & Chr(34) & "★" & 区切り文字 & ケンメイ & Chr(34)
            検索開始行 = 検索行 '+ 1 照合先のキー重複が無ければ、次の検索は、合致した行の次からで良い
            合致件数 = 合致件数 + 1
            合致 = "合致"
            Exit For
         End If
      Next 検索行
      If 合致 = "" Then
         出力行 = 入力行
      End If
      出力テキストストリームオブジェクト.WriteLine 出力行         ' 改行(CrLf)付き

   Next 処理行
   
   ' 指定ファイルをClose(出力モード)
   出力テキストストリームオブジェクト.Close
   Set 出力テキストストリームオブジェクト = Nothing

   ThisWorkbook.Worksheets("Sheet1").Activate
    Range("B7").Value = 合致件数

End Sub


'********************************************************
Private Sub マスタファイル読み込み()

    現在のパス = ActiveWorkbook.Path
    処理内容 = "マスタ・ファイル読み込み"
    
   ThisWorkbook.Worksheets("Sheet1").Activate
    入力ファイル名 = "ZipCode2009.txt"
        
   マスタファイル名 = 現在のパス & "\" & 入力ファイル名
   
   ' 指定ファイルをOPEN(入力モード)
    Set 入力テキストストリームオブジェクト = _
    ファイルシステムオブジェクト.OpenTextFile(マスタファイル名, 1)

   入力件数 = 0

     Do Until 入力テキストストリームオブジェクト.AtEndOfStream
   
         入力行 = 入力テキストストリームオブジェクト.ReadLine
         入力件数 = 入力件数 + 1
         ReDim Preserve マスタ配列(入力件数)
         
         If (入力件数 Mod 10000) = 0 Then
            Application.StatusBar = "☆" & 入力件数 & " 行目を読込み☆ " & 処理内容
         ElseIf (入力件数 Mod 5000) = 0 Then
            Application.StatusBar = "★" & 入力件数 & " 行目を読込み★ " & 処理内容
         End If
                           
         マスタ配列(入力件数) = 入力行
         
   Loop
   
   ' 指定ファイルをClose(入力モード)
   入力テキストストリームオブジェクト.Close
   Set 入力テキストストリームオブジェクト = Nothing
   
   マスタ件数 = 入力件数
   ThisWorkbook.Worksheets("Sheet1").Activate
    Range("B5").Value = マスタ件数

End Sub


'********************************************************
Private Sub ワークファイル読み込み()

    現在のパス = ActiveWorkbook.Path
    処理内容 = "ワーク・ファイル読み込み"
    
   ThisWorkbook.Worksheets("Sheet1").Activate
    入力ファイル名 = "ADD0702_0902.txt"
        
   ワークファイル名 = 現在のパス & "\" & 入力ファイル名

   ' 指定ファイルをOPEN(入力モード)
    Set 入力テキストストリームオブジェクト = _
    ファイルシステムオブジェクト.OpenTextFile(ワークファイル名, 1)
    
   入力件数 = 0

     Do Until 入力テキストストリームオブジェクト.AtEndOfStream
   
         入力行 = 入力テキストストリームオブジェクト.ReadLine
         入力件数 = 入力件数 + 1
         ReDim Preserve ワーク配列(入力件数)
         
         If (入力件数 Mod 10000) = 0 Then
            Application.StatusBar = "☆" & 入力件数 & " 行目を読込み☆ " & 処理内容
         ElseIf (入力件数 Mod 5000) = 0 Then
            Application.StatusBar = "★" & 入力件数 & " 行目を読込み★ " & 処理内容
         End If
                           
         ワーク配列(入力件数) = 入力行
         
   Loop
   
   ' 指定ファイルをClose(入力モード)
   入力テキストストリームオブジェクト.Close
   Set 入力テキストストリームオブジェクト = Nothing
   
   ワーク件数 = 入力件数
   ThisWorkbook.Worksheets("Sheet1").Activate
    Range("B6").Value = ワーク件数

End Sub

この種類の目次に戻る↑ 索引へ↓ トップページに戻る



ホームページのトップに戻る