ExcelUserForm,Txtデータを列取得

質問

Txtファイルにあるデータがコンマで区切られています。並びをAからJとします。Aの前には日付が入っています。複数のテキストファイルを持ちいります。
ExcelのUserFormを使い、テキスト（拡張子Txt）のデータを列ごと取得しようと思っております。たとえば図のようにBのチェックボックスにチェックを入れ、ExecuteButton1を押すと「-509999.9987」データと日付のみ、新しいExcelファイルにデータを入れるという方法です。
並びとしましてUserForm1の中にPage1がありその中にFrame1が入って、Checkboxがあります。
テキストオープン＞新規のExcelシートを作成する＞選択したタグを列で取得する＞新規のExcelシートに取得したデータを詰めて張り付ける（その時日付とデータを張り付ける）。
たとえばチックボックス1と4にチェックが入っていたとします。コンマの間と間のデータを取得しようとすると、1列目のデータは日付なので、2列目と5列目を取得したいと思いますがうまくいきません。　
チェックボックスの1番目にレ点があると下記のようになります。
If Me.Controls("CheckBox1").Value = True Then
If Me.Controls("CheckBox2").Value = True Then
If Me.Controls("CheckBox3").Value = True Then
して行くと、200以上のチェックボックスがある場合それを200以上作らないといけません。
また、下記のようにすると。
.......................
For i = 1 To 200
If Me.Controls("CheckBox" & i).Value = True Then
~~~~~~~~~
else
~~~~~~~~~
next i
..........................
たとえば1と4列目が正（True）の場合であっても、テキストの中身のデータを的確に2列目と5列目を取得するのが難しいです。
どなたか簡単にできる方法を教えていただけますでしょうか。どうぞよろしくお願いいたします。

回答No.6

SI299792 · ベストアンサー

判りません。とりあえず、私が最初に送ったプログラムでやってみていただけますが。
それでうまくいけば、あなたが作った前半部分に問題がある訳です。
データも、上げていただいたテストデータを使ってください。

前半部分に関しては、私には理解不能なので、協力できません。自分で対応するか、他の人に聞いて下さい。

本番データはどうなっているのですか、もし、テストデータのような数字だけなら、前半部分は不要だと思います。シフトジス以外で漢字が入っているならコード系を書いた上で、本番に近いテストデータを上げて下さい。
私は、シフトジス以外のファイルを扱った事がないので、
「VBA でUTF8のファイルを読みたい」など、他の人に聞いた方が早いです。

お礼

間違い
しかし、データ張り付けの時に行が詰まってしまいます。検索すると空白の削除が出てきます。ただ上に詰めてコピーするには、どうすればいいでしょうか？　
正解
しかし、データ張り付けの時に行が空白になってしまいます。ネットで検索すると空白の削除が出てきますが、ただ上に詰めてデータを張り付けていくには、どうすればいいでしょうか？

補足

ありがとうございます。ちょっと長い間作業が手に付けられませんでした。他のマクロも入れ、下記のようなファイルができました。

しかし、データ張り付けの時に行が詰まってしまいます。検索すると空白の削除が出てきますが、ただ上に詰めてコピーするには、どうすればいいでしょうか？　どうぞよろしくお願いします。

While Not EOF(1)
DoEvents
Line Input #1, FileData
Row = Row + 1
ISplit = Split(FileData, ",")
ArrayMax = UBound(ISplit)
DateData = ISplit(0)

ColO = 1
'
a = a + 1

If a Mod factor_ENV = 0 Then
For ColI = 1 To WorksheetFunction.Min(200, ArrayMax)

If Controls("CheckBox" & ColI).Value Then
ColO = ColO + 1
Cells(Row, ColO) = ISplit(ColI)
Cells(Row, "A") = Format(DateData, "####/##/##　##:##:##")

End If
Next ColI
End If

回答No.10

SI299792

私は、こんなプログラム組んだ覚えはありません。何で
Cells(Row + 1, "A") = Format(DateData, "####/##/##　##:##:##")
がループの中にあるのですか？

質問の、ExcelUserForm,Txt データを列取得には、十分答えていると思います。

回答No.9

SI299792

新しいワークブックを作るんだったら、直接開いて、不要な部分を削除した方が良いのではないかと思って。プログラムを作ってみました。プログラムは簡単になりました。
但し、大きな数字を、セルに入れると、2.01801E+16 のような、指数表示となります。これを文字列に入れてFormatをかけると、// ::2となるので、長整数にして、1000で割る方式にしました。
質問です。どっちの方法を使うにしろ、これによりプログラムは変わります。
(1)１行目、[0,1,2,3,4,5,6,7,8,9,10]は必要なのか。（不要としました）
(2)Keep every other row of data等を指定した時、どのデータを取るのか。
２行目（曜日）のデータを取り、後は指定回数-1削除としました。
例えば、Keep every 5th ...だったら、2(曜日行),7,12…行を取り、後は削除します。

お礼

どうもありがとうございます。データが多いとやりにくいと思い、少なめにしていました。

補足

ありがとうございます。
何回もすみません。
そこで28行目と32行目が必要なデータになるのですが、2個以上のテキストファイルの選択となると今までのマクロではうまく使えないわけです。

回答No.8

SI299792

テストデータを見て、最初の２行は必要ないのだと思ってしまいました。
最初の回答でで、「最初の２行は読み飛ばしました。」と明記したつもりだったですが。
これは、ループに入る前に、
　　Line Input #1, FileData
が２行並んでいるので、それを１行にすれば、最初の
0,1,2,3,4,5,6,7,8,9,10
だけが読み飛ばされます。なくしてしまえば、最初の行も出力されます。

ただ、漢字を使うとなると、コード系が問題となります。
VBはシフトジスコードしか扱えないので、シフトジスコードなら、これで問題はありませんが、他のコード系であれば、これでは動きません。その場合、もう一度、テータを上げていただいた上で、コード系が何なのかをを書いて下さい。対策を考えます。
（最近、UTF8、UNICODE などあるので、困っています。）

お礼

どうもありがとうございます。
Line Input #1, FileDataのデータは一行ずつ書き込んでいくわけですが、行の指定はできますでしょうか。実際28行目から必要なタイトルデータがあるので、28行目を1行目に。32行目から本格的な数値データが入っているので、そこからデータを読み込みたいと思っております。どうぞよろしくお願いいたします。

補足

objStream.Charset だと "ascii" '"Shift-JIS" '"UTF-8"ということですよね。
objStream.Charset = "ascii" '"Shift-JIS" '"UTF-8"
Set objStream = CreateObject("ADODB.Stream")　はこちらへ作り始めましたが、
Roseのところがすべてのデータを拾ってしまうので分割して列のデータを拾うやり方がいまいちわからず断念しております。

そこで下記を作ってでやってみましたが、数字（番号）が出てきてうまくいきません。Stringでの使い方が、いまいちわかりません（すみません独学でやってます）。
Private Sub CommandButton1_Click()
'
Dim Shape As Shape
Dim FileData As String
Dim ISplit As Variant
Dim ISplit2 As Variant
Dim DateData As String * 14
Dim Row As Long
Dim ArrayMax As Integer
Dim Point As Integer
Dim Col As Integer
Dim factor_ENV As Long
Dim Count As Long
'
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "Select txt([Date_#_Test#].txt) files", "*.txt"
'
If Not .Show Then
End
End If
Open .SelectedItems(1) For Input As #1
End With

'Line Input #1, FileData
Line Input #1, FileData

Application.ScreenUpdating = False
' Cells.ClearContents
'
For Each Shape In ActiveSheet.Shapes("Group 2").GroupItems
'
If Not Shape.Name Like "Keep*" Then
ElseIf Shape.ControlFormat = 1 Then
factor_ENV = Mid(Shape.Name, 5)
End If
Next Shape
'
Workbooks.Add
Columns("A:A").ColumnWidth = 18
'
'-----------------------------------------------------------------
' Do Until EOF(1)
' DoEvents
ISplit2 = Split(FileData, ",")
ArrayMax2 = UBound(ISplit2)
'DateData2 = ISplit2(1)
Row2 = Row2 + 1
Col2 = 1

Line Input #1, FileData

For Point2 = 1 To WorksheetFunction.Min(12, ArrayMax2)
If Controls("CheckBox" & Point2).Value Then
Col2 = Col2 + 1
Cells(Row2, Col2) = ISplit2(Point2)
End If

Next
' Loop
'-----------------------------------------------------------------

Do Until EOF(1)
' DoEvents
Line Input #1, FileData
Count = Count + 1
'

If Count Mod factor_ENV = 0 Then
ISplit = Split(FileData, ",")
ArrayMax = UBound(ISplit)
DateData = ISplit(0)
Row = Row + 1
Col = 1
'

For Point = 1 To WorksheetFunction.Min(12, ArrayMax)

If Controls("CheckBox" & Point).Value Then
Col = Col + 1
Cells(Row + 1, Col) = ISplit(Point)
Cells(Row + 1, "A") = Format(DateData, "####/##/##　##:##:##")
End If
Next Point
End If
Loop
Close
Me.Hide
End Sub

回答No.7

SI299792

ファイルを拝見しました。いろいろな機能を付けたのですね。

Row が出力行です。
したがって、Ifで出力しない事があるなら、
Row = Row + 1
をIfの中に入れる必要があります。

Cells.ClearContents
は、セルを全てクリアします。
Workbooks.Add
をするなら必要ないし、開始画面の内容を消してしまうので、外して下さい。

Application.ScreenUpdating = Falseを入れれば若干早くなります。

DoEventsは非常用です。これを入れておけば、何かあったとき、Esc で止めることができます。若干スピードは落ちます。テスト中は入れておいたほうがいいです。本番はどうするかは判断に任せます。

For Point = 1 To WorksheetFunction.Min(12, ArrayMax)
12はボタンの個数です。もし、
For Point = 1 To UBound(ISplit)
とすると、１行にデータが13個あればエラーになります。それを防ぐためです。ボタンを増やしたら増やして下さい。（本当に 200もボタンを付けるのですが、ということは、本番データは横に 200並んでいるということでしょうか。）

Sheet1のオプションボタンの名前の中に、値を入れておけば、ループでできて、IFを並べる必要はなくなります。

変数名を若干変えました。
ColI ColumnInput の略だったのですが、入力データはセルではないのでColumnはおかしいです。Point にしました。
ColO Input Outputに分ける必要がなくなったので、Col にしました。

後、Set objStream = CreateObject("ADODB.Stream")…
の部分はどうなりましたか？

ギガファイル便、使ってみました。ヤフーボックスと違って、xlsmが使えるのがいいですね。でも、上書きできないのが不便です。
URL を記録し忘れて、行方不明となったファイルが、数本あります。

お礼

どうもありがとうございます。なるほど、まだまだ多様性がわかっていないので、お手数をおかけします。

補足

どうしてLine Input #1, FileDataとすることによって、テキストデータ（20180117_test.txt）の最初の部分（下記）が検出去れなのでしょうか？

0,1,2,3,4,5,6,7,8,9,10
日付,A,B,C,D,E,F,G,H,I,J

上記のデータ（日付,A,B,C,D,E,F,G,H,I,J）も入れたいのですが、出てきません。
例えばこんな風に
__Date/Time|__________B|__________C
2018/1/17 1:40|______-509999.9993|______-0.005320536
2018/1/17 1:40|______-510000.0036|______-0.009062112

回答No.5

SI299792

多分これで動くと思います。どうしても名前を変更しないならどうするかも、考えていたので、少し残念です。しかし、(2)～(4)のやり方は、無駄にプログラムが複雑になるので、(1)が可能なら、(1)が１番いいです。

　プログラムを拝見しましたが、前半部は私が見たことのない命令ばかりで理解できません。私のようなおじんは、昔のBasic に無かったものはなかなか理解できません。Option Explicitも、最近使えるようになりました。綴りが覚えれられず、コーディングのたびにググっています（笑）。
　でも、なんとなく、UTF8を読んでいるのではないかといういう感じです。テストデータは数字だけでしたが、本番は漢字もあるということでしょうか。

　気になったのは、
CurDir ("C:\")
です。これ、何もしませんよ。（昔のBasic ならエラーになっていました）
CurDirはカレントディレクトリを取り出す関数です。
　　Debug.Print CurDir("C:")
又は、
　　PathName = CurDir("C:")
のようにしないと機能しません。
カレントディレクトリを変更したいのなら、
　　ChDrive "C:"
　　ChDir "C:\"
とする必要があります。
また、何かあったら書いて下さい。

お礼

ありがとうございます。　実行時エラーはでなくなりましたが、結果が、”//　::”　になってしまいます。どうすれば改良ができますでしょうか？

回答No.4

SI299792

先ず、前回送ったプログラムにミスがありました。VBは配列が０から始まるのでこうなります。
'
　　　　If chk_A.Value Then
　　　　　　ColO = ColO + 1
　　　　　　Cells(Row, ColO) = ISplit(1)
　　　　End If
'
　　　　If chk_B.Value Then
　　　　　　ColO = ColO + 1
　　　　　　Cells(Row, ColO) = ISplit(2)
　　　　End If
　　　　　　︙

Excel をコピペをすると、横のセルの間には、一見スペースがあるように見えますが、Tab が入ります。Tab は、OKWAVEでは無視されます。私は必ず確認画面を見ています。

質問に、
If Me.Controls("CheckBox1").Value = True Then
と書いてあったので、てっきり、名前を変更していないものと思いました。
Controls()は、Control.Nameで付けた名前で指定する必要があります。
chk_A という名前を付けているなら、
Controls("CheckBox1")
ではだめで、
Controls("chk_A")
とする必要があります。

対策です
(1)名前をCheckBox1,2 …に戻す。私はこれが一番いいと思います。
どうしても名前と表示を一致させないと混乱するというのであれば、以下の方法が考えれれます。
(2)IF文を200 連ねる。
　　　　If chk_A.Value Then ColO = ColO + 1 : Cells(Row, ColO) = ISplit(1)
　と書けば、１行ですみます。本来やっていはいけない書き方ですが、この際やむを得ません。
(3)For Eachを使って、全てのControlsを見る。チェックボックスだったら処理をする。
　chk_B を作り忘れて後から作ったなど、チェックボックスを作る順番を間違えれば狂います。
(4)１→Ａ、２→Ｂ…と変換するプログラムを作る。
　Ｚまでなら簡単にできます。その後AAになると思うのですが、それでいいですか？
どれにするか決めてご記入下さい。
（(1)、(2)なら自分でできると思います）

お礼

どうもありがとうございます。
macro2の結果を下記に変更しました。

CommandButton1> ExecuteButton1
CommandButton2> Cancel
MultiPage1
Frame1> Frame1
Frame2> Frame2
CheckBox1> A
CheckBox2> B
CheckBox3> C
CheckBox4 >D
CheckBox5> F
CheckBox6>G
CheckBox7>H
CheckBox8>I
CheckBox9>J
CheckBox10>K

補足

どうしてLine Input #1, FileDataとすることによって、テキストデータ（20180117_test.txt）の最初の部分（下記）が検出去れなのでしょうか？

0,1,2,3,4,5,6,7,8,9,10
日付,A,B,C,D,E,F,G,H,I,J

上記のデータ（日付,A,B,C,D,E,F,G,H,I,J）も入れたいのですが、出てきません。

回答No.3

SI299792

While ～WendをDo～Loopに置き換えても何の問題もありません。
判っていたのですが、つい、慣れている、While を使ってしまいます。

Openは以下に置き換えて下さい。（私はこの書き方しか知りません。Application.FileDialogの後ろに直接Filters.Addを書く方法は知りませんので）
'
　　With Application.FileDialog(msoFileDialogOpen)
　　　　.Filters.Clear
　　　　.Filters.Add "Select txt([Date_#_Test#].txt) files", "*.txt"
'
　　　　If Not .Show Then
　　　　　　End
　　　　End If
　　　　Open .SelectedItems(1) For Input As #1
　　End With

＞＞今の設定はこうなっております。
これは、Macro2を実行した結果でしょうか。
ということは、チェックボックスの名前（オブジェクト名）を変更したということでしょうか。そうであればこのプログラムは使えません。（名前と表示がくっついているので、どこまでが名前か判りません。多分chk_A が名前でＡ が表示だと思います。今後、間にスペースを入れるなど、分かるように書いていただけたらと思います。）
名前ををCheckBox1,CheckBox2 のように元に戻すか、IF文を連ねるプログラムにするかしかありません。
For ～Nextを以下に置き換え
'
　　　　If chk_A.Value Then
　　　　　　ColO = ColO + 1
　　　　　　Cells(Row, ColO) = ISplit(2)
　　　　End If
'
　　　　If chk_B.Value Then
　　　　　　ColO = ColO + 1
　　　　　　Cells(Row, ColO) = ISplit(3)
　　　　End If
　　　　　　︙
大変だと思います。
名前と表示(Caption) は違っていても問題はありません。名前を変えたほうがいいと思います。

お礼

即答、ご返事どうもありがとうございます。
すみません。急いでしまいました。
Macro2を実行した結果が下記になりました。（Excelの結果を出し、コピペした時にはスペースがあったのですが。。。結果、左がControl.Nameで右がControl.Captionです。”＞”で区切りました。
CommandButton1　＞ExecuteButton1
CommandButton2 > Cancel
MultiPage1 （Control.Captionなし）
Frame1 > Frame1
Frame2 > Frame2
chk_A > A
chk_B > B
chk_C > C
chk_D > D
chk_F > F
chk_G > G
chk_H > H
chk_I > I
chk_J > J
chk_K > K
またテストして、補足コメントに入力します。

補足

ありがとうございます。すみません。まだいろいろ試していて、初めにもらったスクリプトを自分の持っているスクリプトと足して創作中です。　下記のようにしてみましたが、「If Me.Controls("CheckBox" & ColI).Value = False Then」で同じ実行時エラーが発生しています。これから変化はできますか？　新しくもらったスクリプトを試したいと思います。

Private Sub CommandButton1_Click()

Dim FileLoad As Integer
Dim strfullpath As String
Dim i As Integer
Dim OpenFileName As Variant
Dim IngCount As Long
'
Dim FileData As String
Dim ISplit As Variant
Dim DateData As String * 14
Dim Row As Long
Dim ArrayMax As Integer
Dim ColI As Integer
Dim ColO As Integer

CurDir ("C:\")
'User selected all desired env files.

Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = True

'make the file dialog visible to the user
Application.FileDialog(msoFileDialogOpen).Filters.Clear
Application.FileDialog(msoFileDialogOpen).Filters.Add "Select *.txt files", "*.txt"
FileLoad = Application.FileDialog(msoFileDialogOpen).Show

'If files selected > 0 then continue with main code
If FileLoad <> 0 Then

On Error GoTo 0

Application.StatusBar = "Importing ILCH Data... Please be patient."

For i = 1 To Application.FileDialog(msoFileDialogOpen).SelectedItems.Count
strfullpath = Application.FileDialog(msoFileDialogOpen).SelectedItems(i)

Set oFSObj = CreateObject("SCRIPTING.FILESYSTEMOBJECT")
strFilePath = oFSObj.GetFile(strfullpath).ParentFolder.Path
strFileName = oFSObj.GetFile(strfullpath).Name

'Data Stream Definition
Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "ascii" '"Shift-JIS" '"UTF-8"
objStream.Type = 2 'adTypeText 'default
objStream.Open

'(10 Line feed only) 'adCR '(13 Carriage return only改行復帰) 'adCRLF '(-1 Default. Carriage return line feed改行復帰行送り（デフォルト）)'adLF '(10 Line feed only行送り)
objStream.LineSeparator = 10
objStream.LoadFromFile strfullpath
objStream.Position = 0 '5771

S1 = 0

'While Not EOF(1)

Do Until objStream.EOS
Rose = objStream.ReadText(-1) '(adReadLine)
Row = Row + 1
ISplit = Split(Rose, ",")
ArrayMax = UBound(ISplit)
DateData = ISplit(0)
Cells(Row, "A") = Format(DateData, "####/##/##　##:##:##")
ColO = 1

For ColI = 1 To WorksheetFunction.Min(200, ArrayMax)
'
If Me.Controls("CheckBox" & ColI).Value = False Then
' Worksheet("Sheet1").Select
GoTo continue
Else
'On Error GoTo 0
ColO = ColO + 1
Cells(Row, ColO) = ISplit(ColI)
End If
continue:
Next ColI
'Wend
Loop '
Close
Me.Hide

objStream.Close
Set objStream = Nothing
Next i
End If
End Sub

回答No.2

SI299792

指定されたチェックボックスがなければこのエラーが出ます。
チェックボックスを作っているときに、削除などを行い、実際の名前と表示が合わなくなったと思います。画像の赤〇のようなことがあるのではないでしょうか。
エラーが出た時に、デバックを選択しイミディエイトで
? ColI
と入力すれば、どのボタンが無いかわかります。

標準モジュールで以下のプログラムを動かせば、一覧表ができるので、確認して下さい。
'
Sub Macro2()
'
　　Dim Control As Control
　　Dim Row As Integer
'
　　For Each Control In UserForm1.Controls
　　　　Row = Row + 1
　　　　Cells(Row, "A") = Control.Name
　　　　On Error Resume Next
　　　　Cells(Row, "B") = Control.Caption
　　　　On Error GoTo 0
　　 Next Control
End Sub

お礼

ありがとうございます。今の設定はこうなっております。
CommandButton1 ExecuteButton1
CommandButton2 Cancel
MultiPage1
Frame1 Frame1
Frame2 Frame2
chk_A A
chk_B B
chk_C C
chk_D D
chk_F 　　　F
chk_G G
chk_H H
chk_I 　　　I
chk_J 　　　J
chk_K K

補足

Open "C:\Users\MA\Desktop\My Documents\質問解答\OKWAVE\20180117_test.txt" For Input As #1
を今まで使っていた、下記に変更したいのですが、　”For Input As #1”
を追加するとそこでエラーになってしまいます。どうしたらいいでしょうか。
Application.FileDialog(msoFileDialogOpen).Filters.Add "Select txt([Date_#_Test#].txt) files", "*.txt"

回答No.1

SI299792

テストデータを拝見しましたが、データは10しかありませんね。
このようなプログラムでどうですか。ボタンが何個あっても、この長さで行けます。
'
Option Explicit
'
Private Sub CommandButton1_Click()
'
　　Dim FileData As String
　　Dim ISplit As Variant
　　Dim DateData As String * 14
　　Dim Row As Long
　　Dim ArrayMax As Integer
　　Dim ColI As Integer
　　Dim ColO As Integer
'
　　Open "C:\Users\MA\Desktop\My Documents\質問解答\OKWAVE\20180117_test.txt" For Input As #1
　　Line Input #1, FileData
　　Line Input #1, FileData
　　Application.ScreenUpdating = False
　　Cells.ClearContents
'
　　While Not EOF(1)
　　　　DoEvents
　　　　Line Input #1, FileData
　　　　Row = Row + 1
　　　　ISplit = Split(FileData, ",")
　　　　ArrayMax = UBound(ISplit)
　　　　DateData = ISplit(0)
　　　　Cells(Row, "A") = Format(DateData, "####/##/##　##:##:##")
　　　　ColO = 1
'
　　　　For ColI = 1 To WorksheetFunction.Min(200, ArrayMax)
'
　　　　　　If Controls("CheckBox" & ColI).Value Then
　　　　　　　　ColO = ColO + 1
　　　　　　　　Cells(Row, ColO) = ISplit(ColI)
　　　　　　End If
　　　　Next ColI
　　Wend
　　Close
　　Me.Hide
End Sub

ファイル名の指定方法がなかったので、直接ソースに書きました。
最初の２行は読み飛ばしました。
１列目のデータは日付とありましたが、実際は17桁ありるので日付と時刻とコードであると解釈し、残りの３桁は切り捨てました。

実データは 200もあるのですか。大変ですね。作るのも大変だけど、使うのも大変だと思います。

お礼

ありがとうございます。しかし、実行時エラーが出まして、苦戦してますが、Excelに何かほかの設定されてませんでしょうか？

実行時エラー'-21470224809(80070057)':
指定されたオブジェクトは見つかりません。

補足

While～Wendステートメントは、Do～Loopステートメントの前判断、While条件と同じ意味になり, できるだけDo～Loopステートメントに置き換えておくことをお勧めします。と下記のサイトにあるので変えようとしています。While～Wendステートメントが原因でエラーが発生しますか？http://home.att.ne.jp/zeta/gen/excel/c04p21.htm