
Excel VBA に詳しい方ご指導ください 下記のようなタブ区切りのテキストファイ...
2018/6/1323:21:42
Excel VBA に詳しい方ご指導ください
下記のようなタブ区切りのテキストファイルがあります。
1列目の数値の最大数値の個数を調べる方法を教えてください。
下記の場合ですと、「99が3個ある」が答えとなります。
これを実現するには、下記のテキストを読み込むだけの VBA に
どうコードを追加すればいいですか。
詳しい方がいらっしゃいましたらご指導の程よろしくお願い致します。
テキストファイルの中身
44[TAB]4045
11[TAB]1011
2[TAB]2020
33[TAB]3830
55[TAB]5250
7[TAB]7070
88[TAB]8081
55[TAB]5850
99[TAB]9790
66[TAB]6960
22[TAB]2420
55[TAB]5058
99[TAB]9290
11[TAB]1810
55[TAB]5650
3[TAB]3039
99[TAB]9095
以下は、テキストを読み込むだけの VBA です
Option Explicit
Sub Sample()
Dim Fname As Variant
Dim N As Integer
Dim D As String
ChDrive ThisWorkbook.Path
ChDir ThisWorkbook.Path
Fname = Application.GetOpenFilename("TXT(*.txt),*.txt", MultiSelect:=False)
If VarType(Fname) = vbBoolean Then Exit Sub
N = FreeFile
Open Fname For Input As #N
Do Until EOF(N)
Line Input #N, D
Loop
Close #N
End Sub
ベストアンサーに選ばれた回答
2018/6/1406:31:23
書かれているコードを使う事が条件なら、その一例です。
Sub Sample()
Dim fname As Variant
Dim N As Integer
Dim D As String
Dim tbl As Variant
Dim svn As Long
Dim cnt As Long
ChDrive ThisWorkbook.Path
ChDir ThisWorkbook.Path
fname = Application.GetOpenFilename("TXT(*.txt),*.txt", MultiSelect:=False)
If VarType(fname) = vbBoolean Then Exit Sub
svn = -1
N = FreeFile
Open fname For Input As #N
Do Until EOF(N)
Line Input #N, D
If InStr(D, vbTab) > 0 Then
tbl = Split(D, vbTab)
If IsNumeric(tbl(0)) = True Then
If tbl(0) > svn Then
svn = tbl(0)
cnt = 1
ElseIf tbl(0) = svn Then
cnt = cnt + 1
End If
End If
End If
Loop
Close #N
MsgBox svn & "が" & cnt & "個ある"
End Sub
この回答は投票によってベストアンサーに選ばれました!
ベストアンサー以外の回答
1〜2件/2件中
- 並び替え:回答日時の
- 新しい順
- |古い順
2018/6/1415:11:29
「テキストファイル」ということで、エクセルの機能を使わない(エクセルそのものを使わない)「VBScript」による回答です(★★★のちに、「VBA」版も掲載します)。
このプログラムは、目的のテキストファイル(「~.txt」ファイル)を、1つだけ、プログラムファイルにドラッグ&ドロップするだけです。
以下のプログラムを、メモ帳かテキストエディタに貼り付け、「~.vbs」という名前で保存します。
「~」の部分は、何でもかまいませんが、「.vbs」の部分は、必ず、半角です。
できたプログラムファイルに「~.txt」ファイルを1つだけ、ドラッグ&ドロップするだけです。
Option Explicit
Dim a, c, m, n, so, tx, wa
Set so = CreateObject("Scripting.FileSystemObject")
Set wa = WScript.Arguments
If wa.Count <> 1 or Lcase(so.GetExtensionName(wa(0))) <> "txt" Then
MsgBox("ドラッグ&ドロップできるのは、txtファイル1つだけです")
WScript.Quit
End If
Set tx = so.OpenTextFile(wa(0), 1)
m = 0
Do Until tx.AtEndOfStream
a = Split(tx.ReadLine, vbTab)
c = a(0) * 1
If m = c Then
n = n + 1
ElseIf m < c Then
m = c
n = 1
End If
Loop
tx.Close
Set tx = Nothing
MsgBox(m & "が" & n & "個ある")
Set wa = Nothing
Set so = Nothing
簡単な説明です。
Set so = CreateObject("Scripting.FileSystemObject")
ファイルやフォルダを扱えるようにしていますが、今回は特に、「テキストファイル」を扱うのにも必要です。
Set wa = WScript.Arguments
If wa.Count <> 1 or Lcase(so.GetExtensionName(wa(0))) <> "txt" Then
MsgBox("ドラッグ&ドロップできるのは、txtファイル1つだけです")
WScript.Quit
End If
ドラッグ&ドロップされるのを待っていて、ドラッグ&ドロップされると、その数や拡張子を調べ、想定外なら、メッセージを表示して、プログラムそのものを終了してしまいます。
Set tx = so.OpenTextFile(wa(0), 1)
ドラッグ&ドロップされたファイルを「読み込み専用」で開いています。
m = 0
最大値を格納する変数の初期化。
Do Until tx.AtEndOfStream
ファイルの終端まで処理。
a = Split(tx.ReadLine, vbTab)
「Split()」といのは、区切り記号(今回は「Tab」)を使って、配列変数に格納する関数です。
たとえば、読み込んだ1行が「a[TAB]b[TAB]c」の場合、「a(0) = "a"」、「a(1) = "b"」、「a(2) = "c"」となります。
c = a(0) * 1
読み込んだ値は、文字列になっているので、「*1」して「数値」に変換しています。
If m = c Then
もし、それまでの最大値と一致したら、
n = n + 1
1つカウント。
ElseIf m < c Then
それ以外で、それまでの最大値より大きければ、
m = c
新たに、その値を「m」に入れています。
n = 1
最大値個数用変数を「1」にしています。
End If
Loop
を、ファイルの終端まで繰り返しています。
tx.Close
Set tx = Nothing
ファイルを閉じています。
MsgBox(m & "が" & n & "個ある")
「(最大値)が(何)個ある」と表示しています。
Set wa = Nothing
Set so = Nothing
「Set ~」で使った変数は、使用後「Nothing」で解放しておきます。
★★★考え方は全く同じですが、「VBA」版です★★★
Sub Sample()
Dim a, c As Long, m As Long, n As Long, x As String
Open "D:\Programming\csv\Max.txt" For Input As #1
m = 0
Do Until EOF(1)
Line Input #1, x
a = Split(x, vbTab)
c = Val(a(0))
If m = c Then
n = n + 1
ElseIf m < c Then
m = c
n = 1
End If
Loop
Close #1
MsgBox (m & "が" & n & "個ある")
End Sub
考え方が同じですので、説明の必要はないと思います。
2018/6/1406:34:23
テキストファイルをシートに読み込み、A列のなかで、最大値の数値をカウントするというフローを考えると以下のような手番を踏むと思います。
(1)シートへの書き出し:
i = 10
Do Until EOF(N)
Line Input #N, D
i = i + 1
Cells(i, 1).Value = D
Loop
(2)項目ごとに列を分ける(区切り位置で分割)
'http://www9.plala.or.jp/siouxsie/excel/date01.html
データ~区切り位置のマクロの記録か、splitの繰返しか、などで。
(3)A列で最大値をMAX関数で求めて、最大値をcountif関数で求める。
' 区切り位置で、C列に出力するとした場合、
MsgBox WorksheetFunction.Max(Range("c:c"))
MsgBox WorksheetFunction.CountIf(Range("c:c"), WorksheetFunction.Max(Range("c:c")))
「Dim d As String、Do Until EOF」に関する質問
- アクセスで、Dim strFilter As String, strExp As String, aryOpe As Variant If ...
- Dim File1 as string , wb1 as workbookFile1 = Application.getopenfilenameIf F...
- Sub ReadTxt() Dim myTxtFile As String Dim myBuf(7) As StringDim i As Integer...
- アクセスのレポートで、Dim myRptName As StringmyRptName = "レポート1"If Me.Fi...
- アクセスのフォームで、Dim myRptName As StringmyRptName = "レポート1"If Me.Fi...
このカテゴリの回答受付中の質問
- blendVisualStudioについて。 作成した成果物をメールで送る方法を教えて下さい。...
- AWSのLambdaはサーバレスだそうですがサーバがなくてもプログラムが実行できると...
- VBAが組んであるファイルをいくつか開いてある状態で一つのマクロを実行するとエ...
- エクセルのVBAでテキストを読み込んで一つ作業をしてまたテキストに書き出したい...
- 開発言語がVB.netで.net Framework4.5 Windowsフォームでasp.netのバリデーショ...
- エクセルで複数のファイルからある1つのシートのデータを集計(集める)する方法...
- VBA CDOを利用してGmailの送信済みメール、受信メールを出力するマクロを作成につ...
- UiPathのハンズオンをやっているのですが、行き詰ったので教えていただけませんで...
- Tera TermマクロとExcel VBAの連携について Tera Termでコマンド実行結果を...
- vbsについての質問です。 sendkeysを使って「shiftを押しながらF10を押す」と動作...
このカテゴリの投票受付中の質問
- Excel2013のVBAでDATE関数が上手く機能しません 今日の日付を取得したいのです...
- EXCELのvbaにてオートシェイプの表示をコントロールし、デジタル表示のカウントダ...
- 現在、エクセルVBAでウェブスクレイピングのプログラムを作成中です。 なお、素...
- 現在、エクセルVBAでウェブスクレイピングのプログラムを作成中です。 先ほど、...
- access についてです。 Dlookup関数の練習をしています。 Private Sub コマンド1...
- ExcelのVBAについてです。 テキストボックスに入力した文字列を「登録」コマンド...
- Windows10でvisual studio2017 を使用してc++を勉強しているのですが、今windows...
この質問につけられたタグ
カテゴリQ&Aランキング
- 戻る
- 次へ
総合Q&Aランキング
Yahoo!知恵袋カテゴリ
お客様自身の責任と判断で、ご利用ください。

