• ベストアンサー
  • すぐに回答を!

Excel VBAの文字列と数値の分類

txtファイルで取り込んだ2行にまたがっている数値・英文字・ひらがななどを、数値だけのtxtファイルとそれ以外のtxtファイルを別々に作成し、保存するプログラムを組みたいのですが、よく分かりません。 ちなみに、使っているOSとAPはWinXP、Excel2003です。 InputData.txtの内容 A34bFg7p0 あ 1ylut890 B45LK4L え Number.txtの完成形 34701890454 String.txtの完成形 AbFgp あ ylutBLKL え '変数の宣言 Dim myFile As String Dim CC As Integer Dim XX As Integer Dim WW As Variant Dim str As String Dim tempStr As String Dim B As String Dim C As String myFile = Dir("InputData.txt") 'ファイルの読み込み If myFile = "InputData.txt" Then Open myFile For Input As #1 Do While Not EOF(1) Input #1, myText Loop '書き込みファイルの作成 Open "Number.txt" For Output As #2 Open "String.txt" For Output As #3 '数字・文字列の分類 CC = Len(myFile) For XX = 1 To CC str = Mid(myFile, XX, 1) If str >= 0 And str <= 9 Then B = B & str Else C = C & str End If Next Print #2, B Print #3, C Close #1, #2, #3 'エラーメッセージの表示 Else MsgBox "ファイルは存在しません。" End If ここまでやっている状態です。よろしくお願いします。

共感・応援の気持ちを伝えよう!

  • 回答数2
  • 閲覧数453
  • ありがとう数1

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

  • ベストアンサー
  • 回答No.1
  • n-jun
  • ベストアンサー率33% (959/2870)

各ファイルの保存先はRドライブ直下(R:\)としてます。 Sub try() Dim RegExp As Object Dim myFile As String Dim myText As String Dim str As String Dim B As String Dim C As String Set RegExp = CreateObject("VBScript.RegExp") RegExp.Global = True myFile = Dir("R:\InputData.txt") 'ファイルの読み込み If myFile = "InputData.txt" Then Open "R:\" & myFile For Input As #1 Do While Not EOF(1) Input #1, myText str = str & myText Loop '数字・文字列の分類 RegExp.Pattern = "\D+" B = RegExp.Replace(str, "") '数字を残す RegExp.Pattern = "\d+" C = RegExp.Replace(str, "") '数字以外を残す '書き込みファイルの作成 Open "R:\Number.txt" For Output As #2 Open "R:\String.txt" For Output As #3 Print #2, B Print #3, C Close #1, #2, #3 Set RegExp = Nothing 'エラーメッセージの表示 Else MsgBox "ファイルは存在しません。" End If End Sub 適宜修正の上、ご参考程度に。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

教えていただ見た皆さんありがとうございました。 おかげさまで無事出来ました。 これからも精進して頑張っていきますので、また困りましたら宜しくお願いいたします。

関連するQ&A

  • Excel VBA 文字列を配列にて格納

    初心者なので、申し訳ございません。 使用しているOS WinXP、アプリケーション Excel2003 保存してあるtxtファイルに入っている文字列を、重複するデータをグループ化して、最終的に別のtxtファイルにて出力するのですが、最初の配列して格納するところから分かりません。 参考までに・・・ 入力ファイル「InputData.txt」 相川 関本 川上 関本 久保 相川 川上 久保 青木 出力ファイル「Group.txt」 相川 関本 川上 久保 青木 今のところは、ここまでやっています。 Dim A As String Dim myText2 As String A = Dir("InputDate.txt") If A = "InputDate.txt" Then Open A For Input As #1 Do While Not EOF(1) Input #1, myText2 myText = myText & myText2 Loop Open "Group.txt" For Output As #2 よろしくお願いします。

  • 配列にて格納したデータの出力

    txtファイルで取り込んだ2行にまたがっている数値・英文字・ひらがななどを1行ずつ配列として格納した後に、数値だけのtxtファイルとそれ以外のtxtファイルを別々に作成し、保存するプログラムを組みたいのですがよく分かりません。 ちなみに、使っているOSとAPはWinXP、Excel2003です。 InputData.txtの内容 A34bFg7p0 あ 1ylut890 B45LK4L え Number.txtの完成形 34701890 454 String.txtの完成形 AbFgp あ ylut BLKL え '変数の宣言 Dim myFile, myText, myList(), myList2(), str, B, C As String Dim XX As Integer Dim myFunc As Boolean Dim cnt, i As Long On Error GoTo myError myFile = Dir("InputDama.txt") 'ファイルの読み込み If myFile = "InputDama.txt" Then Open myFile For Input As #1 Do While Not EOF(1) Line Input #1, myText If myText <> "" Then If cnt = 0 Then ReDim myList(cnt), myList2(cnt) Else ReDim Preserve myList(UBound(myList) + 1), myList2(UBound(myList2) + 1) End If '数字・文字列の分類 CC = Len(myText) For XX = 1 To CC str = Mid(myText, XX, 1) If IsNumeric(str) = True Then '←数字かどうかはIsNumericで判断 B = B & str Else C = C & str End If Next myList(cnt) = B myList2(cnt) = C cnt = cnt + 1 End If Loop '書き込みファイルの作成 Open "Number.txt" For Output As #2 Open "String.txt" For Output As #3 For cnt = 0 To UBound(myList) Print #2, myList(cnt) Next cnt For cnt = 0 To UBound(myList2) Print #3, myList2(cnt) Next cnt Close #1, #2, #3 End Sub これだと、2行目に1行目で格納したデータが最後出てしまうので、それを取り除きたいのですが、効果的な方法が分かりませんので、宜しくお願いします。

  • ☆文字列を抜き取る★

    テキストファイルに GetPoint = ErrMsg("おはよう",target) の行があるとします。 ダブルクオートでくくられた文字列だけを出力させたい場合 下記コードでどこが間違っているでしょうか?? 今のままだと全てのコードが出力になるんですよ。。。 アドバイスをいただけると幸いです。 Sub Main() Dim iFileNumber As Integer iFileNumber = FileSystem.FreeFile() Open "C:temp\sample.txt" For Input As #iFileNumber Dim stResult As String Dim stSerch As String Dim point As Long Do While (Not FileSystem.EOF(iFileNumber)) Dim stBuffer As String Line Input #iFileNumber, stBuffer stResult = stResult & stBuffer & vbNewLine If Instr(stResult,Chr(34)) > 0 Then If Instr(stResult,Chr(34)) > 0 Then v = stResult End If End If Loop Close #iFileNumber End Sub

その他の回答 (1)

  • 回答No.2
  • mt2008
  • ベストアンサー率52% (885/1701)

まず、INPUTでInputData.txtから読み込む箇所に問題があります。 変数myTextに読み込んだ文字列を入れたいのに、毎回上書きしていますので、最後の行しか入りません。 次に、せっかく変数に読み込んだのに、myTextではなく、ファイル名(InputData.txt)が入っている変数を対象に数字と文字に別けています。 最後に、取り出した1文字が数字かどうかの判断の仕方が間違って居ます。 1行づつステップ実行して、デバッグして見てください。 Dim myFile As String Dim CC As Integer Dim XX As Integer Dim WW As Variant Dim str As String Dim tempStr As String Dim B As String Dim C As String myFile = Dir("InputData.txt") Dim myText2 As String '←1行読み込み用 'ファイルの読み込み If myFile = "InputData.txt" Then  Open myFile For Input As #1  Do While Not EOF(1)   'Input #1, myText ←これではだめ   Input #1, myText2 '←1行読み込み用変数に代入   myText = myText & myText2 '←複数行の文字列を1つの変数にまとめる  Loop  '書き込みファイルの作成  Open "Number.txt" For Output As #2  Open "String.txt" For Output As #3  '数字・文字列の分類  'CC = Len(myFile) ←変数名の間違い  CC = Len(myText) '←変数名の間違い  For XX = 1 To CC   'str = Mid(myFile, XX, 1) ←変数名の間違い   str = Mid(myText, XX, 1) '←変数名の間違い   'If str >= 0 And str <= 9 Then ←数字かどうかはIsNumericで判断   If IsNumeric(str) = True Then  '←数字かどうかはIsNumericで判断    B = B & str   Else    C = C & str   End If  Next  Print #2, B  Print #3, C  Close #1, #2, #3  'エラーメッセージの表示  Else  MsgBox "ファイルは存在しません。" End If

共感・感謝の気持ちを伝えよう!

関連するQ&A

  • Excel 2010 VBA:ファイル名を読み込む

    下は複数のcsvファイルを一つに合体するVBAです。これにシートの右端に読み取ったファイル名を追加するにはどうしたらよいでしょうか。 よろしくお願いします。 Sub macro1() Dim myPath As String Dim myFile As String Dim s As String myPath = ThisWorkbook.Path & "\" On Error Resume Next Kill myPath & "合体版.csv" On Error GoTo 0 myFile = Dir(myPath & "*.csv") If myFile = "" Then Exit Sub Open myPath & "合体版.csv" For Output As #1 Do Until myFile = "" Open myPath & myFile For Input As #2 Do Until EOF(2) Line Input #2, s Print #1, s Loop Close #2 myFile = Dir() Loop Close #1 End Sub

  • accessVBAで特定の文字列を削除

    以前頼んで作ってもらったVBAを少し改造しようと思っていますが、上手くいきませんので質問します。よろしくお願いします。 csvファイルを分割するVBAを作ってもらいました。 1001,a12345678 1001,b15467863546789 1001,b25463254875698 1001,c23564879 1005,a23456753 1005,b25647565823653 1005,c26546875 1007,a23456789 1007,b23659856325632 1007,b46785215468523 1007,c12546873 というcsvファイルを 1001.csvというファイルで中身は 1001,a12345678 1001,b15467863546789 1001,b25463254875698 1001,c23564879 と 1005.csvというファイルで中身は、 1005,a23456753 1005,b25647565823653 1005,c26546875 と 1007.csvというファイルで中身は、 1007,a23456789 1007,b23659856325632 1007,b46785215468523 1007,c12546873 の3つのcsvファイルに分けます。 今回は仕様変更で、 1001.csvというファイルで中身は a12345678 b15467863546789 b25463254875698 c23564879 と 1005.csvというファイルで中身は、 a23456753 b25647565823653 c26546875 と 1007.csvというファイルで中身は、 a23456789 b23659856325632 b46785215468523 c12546873 の3つに分けなくてはならなくなりました。 今使っているVBAは Private Sub DOQUERY_Click() Dim IN_FNO As Integer Dim OUT_FNO As Integer Dim BREAK_OLD As String Dim BREAK_NEW As String Dim HEADLINE As String Dim TEXTLINE As String Dim ARY() As String Dim OUTNAME As String Dim ARYNAME() As String Dim CNT As Integer Dim MSG As String '============================================ On Error GoTo err If IsNull(InputFile) Or IsNull(OutputFile) Then Exit Sub End If If InputFile = "" Or OutputFile = "" Then MsgBox "ファイル名が正しく指定されていません。", vbCritical Exit Sub End If ラベル5.Visible = True DoEvents '読込みCSV OPEN IN_FNO = FreeFile Open InputFile For Input As #IN_FNO '見出し読込み Line Input #IN_FNO, HEADLINE$ '1レコード目読込み Line Input #IN_FNO, TEXTLINE$ '発注番号 ARY() = Split(TEXTLINE$, ",") BREAK_NEW = Replace(ARY(0), """", "") BREAK_OLD = BREAK_NEW '出力CSVファイル名作成 OUTNAME = OutputFile & BREAK_NEW & ".csv" '出力CSVファイル名保存 CNT = 1 ReDim Preserve ARYNAME(CNT) ARYNAME(CNT) = OUTNAME '出力CSV OPEN OUT_FNO = FreeFile Open OUTNAME For Output As #OUT_FNO '見出し書込み Print #IN_FNO, HEADLINE$ '1レコード目書込み Print #IN_FNO, TEXTLINE$ Do While Not EOF(IN_FNO) '次レコード目読込み Line Input #IN_FNO, TEXTLINE$ '発注番号 ARY() = Split(TEXTLINE$, ",") BREAK_NEW = Replace(ARY(0), """", "") '発注番号が変わったとき新しいCSVを開く If BREAK_OLD <> BREAK_NEW Then CNT = CNT + 1 BREAK_OLD = BREAK_NEW '旧書込みCSVをクローズ Close #OUT_FNO '新出力CSVファイル名作成 OUTNAME = OutputFile & BREAK_NEW & ".csv" '新出力CSVファイル名保存 ReDim Preserve ARYNAME(CNT) ARYNAME(CNT) = OUTNAME '新出力CSV OPEN OUT_FNO = FreeFile Open OUTNAME For Output As #OUT_FNO End If '次レコード書込み Print #OUT_FNO, TEXTLINE$ Loop '出力CSVクローズ Close #OUT_FNO '入力CSVクローズ Close #IN_FNO '出力したCSV名称一覧 Dim I As Integer For I = 1 To UBound(ARYNAME()) MSG = MSG & ARYNAME(I) & vbCrLf Next MsgBox CNT & "個のファイルに分割しました。" & vbCrLf + vbCrLf & MSG, vbInformation, "CSV分割" ラベル5.Visible = False Exit Sub err: MsgBox err.Description, vbCritical, "エラー" ラベル5.Visible = False End Sub です。 ファイル名がBREAK_NEWでそれを消せればいいと思うのですが・・・ 以上長くなりましたが、よろしくお願いします。

  • VBAで任意のフォルダ内のファイルの特定の文字列を

    お世話になります。今、Excelを使用しVBAで任意のフォルダ内に含まれるファイル(txt形式ですが拡張子はありません)から、特定のA&#65374;Bの部分の文字列のみを抜き出し、ExcelのSheetに出力させるというVBAを作成しようと考えています。また、A&#65374;Bで抽出した文字列内に”空白”が含まれる場合、その空白でセルを隔てるという処理を加えたいです。 また、それらとは別に任意のフォルダ内に含まれるファイルのファイル名のみを抽出し、Excelに出力するというVBAも作ろうと考えています。 私自身、これまでExcelでは関数を使うのが精一杯でVBAの勉強すらしてきませんでしたので、だいぶ困窮しております。 どなたか、VBAについて詳しい方、ご教授いただけたら幸いです。 以下は、参考までに、特定のフォルダ内に含まれるファイルをSheetに出力するVBAになります。 ここからさらに、任意の文字列を検索し、抽出し、出力する機能と、また空白部分でセルを分ける機能、またファイル名一覧を抽出する機能を加えていきたい所存です。 どなたか、お力添えの程何卒よろしくお願い致します。 Sub GetAllFile() Dim buf As String, tmp As Variant, cnt As Long, i As Long Dim myFol As String, myFile As String Dim fNo As Integer, myCol As Long With Application.FileDialog(msoFileDialogFolderPicker) .Title = "*** 対象フォルダを選択し、[OK]をクリック ***" .InitialFileName = "C:\" If .Show = True Then myFol = .SelectedItems(1) End If End With myFile = Dir(myFol & "\*") myCol = 0 Do While myFile <> "" fNo = FreeFile Open myFol & "\" & myFile For Input As #fNo Do Until EOF(fNo) Line Input #fNo, buf tmp = Split(buf, ",") cnt = cnt + 1 For i = 1 To UBound(tmp) + 1 Cells(cnt, i + myCol) = tmp(i - 1) Next i Loop Close #fNo myFile = Dir() myCol = myCol + 4 cnt = 0 Loop End Sub 上記、VBAは動作はしましたが、やはりフォルダ内のファイル数の数により、途中でフリーズしてしまう事もありました。ご教授の程、何卒よろしくお願い致します。

  • VBA(Excel2003)で文字列の切り出し

    下のプロシージャーで全角半角混じりの文字列を切り出し、別の文字列で結合しようと思いますがうまくいく場合といかない場合があります。 イミディエイト・ウィンドウ上とCell上で動作が違います。 Cell上でうまく表示させるにはどうしたらいいでしょうか? Sub Test() Dim myString(2) As String Dim i As Integer myString(0) = "airueo" myString(1) = "かきくけこ" myString(2) = "さシすせそ" For i = 0 To 2 Debug.Print MidMbcs(myString(i), 1, 5) & "...テスト" Cells(i + 1, 1).Value = MidMbcs(myString(i), 1, 5) & "...テスト" Next i End Sub Function LenMbcs(ByVal str As String) LenMbcs = LenB(StrConv(str, vbFromUnicode)) End Function Function MidMbcs(ByVal str As String, start, length) MidMbcs = StrConv(MidB(StrConv(str, vbFromUnicode), start, length), vbUnicode) End Function

  • VB6.0 文字列のファイル書き込み

    こんにちは。 VB6.0を研修中の新人です。 テキストファイルにランダムアクセスをし半角全角混じりの文字列を書き込むコードを考えています。 連休中は会社に入れないので自宅でコードをどのように書くかある程度決めておきたいです。 ■ あいうえお ■ カキクケコ ■ サシスセソ   (サシスセソは半角です)   ■ タチツテトはひ (タチツテトは半角です) メモ帳.txtに文字列を書き込むと上記のように書き込まれます。 これは見た目が悪いので下記のように"■ "がないように書き込むことは無理でしょうか。 あいうえお カキクケコ サシスセソ    (サシスセソは半角です) タチツテトはひ  (タチツテトは半角です) いま書いたコードは下記のとおりです。 Public Sub Main() WriteFile End Sub '書き込む関数 Public Sub WriteFile()   Dim i As Integer   Dim str As String   Open "C:\メモ帳.txt" For Random As #1 Len = 14   Do While < 5     Select Case i       Case 1 str="あいうえお"       Case 2 str="カキクケコ"       Case 3 str="サシスセソ"       (サシスセソは半角です)       Case 4 str="タチツテトはひふへほ" (タチツテトは半角です)     End Select     strNagasa(str,10) + vbCrlf     Put #1,i,str     i = i + 1   Loop   Close #1 End Sub '文字列をレコードの長さに合わせる関数(いまの場合は10バイト) 'Nagasaが"10"の場合 'strが "サシスセソ" なら "サシスセソ" に半角スペースを5個詰めて返す。 'strが "タチツテトはひふへほ" なら "タチツテトはひ" の9バイトで文字列を切って半角スペースを1個詰めて返す。 Public Function StrNagasa(str As String,Nagasa As Integer) As String   ...   省略(完成済み)   ... End Function

  • (VBA) 配列の文字列を昇順で並べ替えたい

    タイトルの通り、配列に格納したファイル名を昇順に並べ替えたいのですが、期待通りに動作しません。 内部コード(ユニコード?)順には並んでいるようですが、エクスプローラの名前順と同等にはなりません。 どのようにしたら、配列のファイル名をエクスプローラと同じように並べ替えできますか? (テストに使用したコード) Public Sub Test1() Dim FileNames() As String Dim WSH As Object Dim MyPathName As String Dim MyFileName As String Dim i As Integer Dim j As Integer '処理対象フォルダを指定 Set WSH = CreateObject("WScript.Shell") MyPathName = WSH.SpecialFolders("MyDocuments") Set WSH = Nothing i = 0 MyFileName = Dir(MyPathName & "\" & "*.*") If MyFileName = "" Then MsgBox "対象ファイルが1つも見つかりません。", , "処理終了" Exit Sub End If 'ファイル一覧を配列に格納 Do Until MyFileName = "" i = i + 1 ReDim Preserve FileNames(1 To i) FileNames(i) = MyFileName MyFileName = Dir Loop '配列を並べ替える For i = 1 To UBound(FileNames) - 1 For j = i To UBound(FileNames) If FileNames(i) > FileNames(j) Then MyFileName = FileNames(i) FileNames(i) = FileNames(j) FileNames(j) = MyFileName End If Next j Next i End Sub ※以降の処理は、Excel で処理するか Access で処理するかまだ決めていません。  (投稿文字数の関係で詳細は省略)

  • "の文字列長について

    下記のようにテキストファイルより1行読み込んで、 その1行目の文字数(バイト数)を取得する処理を作成しました。 Dim sBuffer As String Open "aaa.txt" as Input For #1 Line Input #1, sBuffer Msgbox sBuffer おおよそはうまく動作するのですが、 テキストファイルの1行目が "aaaaaaaaaa","bbbbbbbbbbbbb" のように、"が含まれていると、"を2バイトと 換算してしまうので、うまく動作しません。 "を1バイトとして換算して、正確な文字数(バイト数)を 取得するのには、どうしたらよろしいのでしょうか?

  • エクセルVBAにてテキスト出力がうまくいきません

    エクセルシートの1列に以下のような文字列を打ち込みました。 - a aa aaa aaaa aaaaa - b bb bbb bbbb bbbbb - c cc ccc cccc ccccc - 「-」の2行後をテキストを出力した際のファイル名とし、ファイル名を含んだ次の「-」までの文字列をそのテキストの中に出力したいです。なお、全体の行数は分かっています。 例えば上の文字列に対して実行すると、 a.txt b.txt c.txt というファイルができ、それぞれの中には a aa aaa aaaa aaaaa などがそれぞれ出力されるようにしたいです。 Sub tepa() Dim strFilename As String Dim FileNumber As Integer Dim strREC As String j = 1 For i = 1 To 70 If Cells(i, 1) = "-" Then strFilename = Cells(i + 2, 1) & ".txt" Do While Cells(i + j, 1) <> "-" If i > 70 Then Exit Sub End If FileNumber = FreeFile strREC = Cells(i + j, 1) Open strFilename For Append As FileNumber Print #FileNumber, strREC Close j = j + 1 Loop End If i = i + j Next End Sub さきほど初めてVBAなるものを知り、見よう見まねで書いてみましたが・・・ループに陥ったりテキストファイルが1つめしか出力されなかったりとうまくいきません。 改善点など教えていただけたら嬉しいです。 よろしくお願いします。

  • エクセルVBA/ Formatで文字列が数値に化ける?

    いつもお世話様です。 エクセルVBAでFormatを使うと、文字列中にeが一つ入っていると、「指数」とみなされて勝手に数値に化けてしまうようです。 話を簡単にするため、問題のコートを簡易化したコードが下記のtest1です。 入力されるのは常に3文字以内の英数です。 test1のコードは、ab9と入れればAB9、01とか20とか入れると、予定通り001や020を返してくれます。 ところが、なかには1E1や4E3なども入力する必要があり、これを入れると010や4000に化けてしまいます。 現在は、対処するため、下記test2のように、文字列中に"E"があるかどうかで処理を分岐させていますが、ほかに何か良い方法はないでしょうか? Sub test1() Dim x As String, y As String, z As String x = Application.InputBox("CODEを入力してねん。", Type:=2) y = StrConv(StrConv(x, vbUpperCase), vbNarrow) z = Format(y, "000") MsgBox z & " Typeだよ。" End Sub Sub test2() Dim x As String, y As String, z As String x = Application.InputBox("CODEを入力してねん。", Type:=2) y = StrConv(StrConv(x, vbUpperCase), vbNarrow) If InStr(y, "E") > 0 Then z = y Else z = Format(y, "000") End If MsgBox z & " Typeだよ。" End Sub

  • ある文字列を検索するボタンのつくりかた

    あるテキストファイル(*.txt)の内容をテキストボックスに表示するボタンを作りました。さらに、このテキストファイルの内容の中から、決まった文字列のみを表示できるようにしたい(例.abcdefgと書かれたテキストに対してbcdのみ抜き出す)のですが、どうすれば良いのでしょうか。初心者なので、簡単にできる方法があれば教えてください。 <現在のコード> Dim myFile As String Private Sub Command1_Click() CommonDialog1.Filter = "テキスト(*.txt)|*.txt|すべて(*.*)|*.*" CommonDialog1.FilterIndex = 1 CommonDialog1.Flags = cdlONFileMustExist '既存ファイルのみ読み込み CommonDialog1.ShowOpen If CommonDialog1.FileName = "" Then Exit Sub myFile = CommonDialog1.FileName FileRead Form1.Caption = "Form1 " & myFile End Sub Private Sub Form_Load() Form1.Height = 3510 End Sub Private Sub FileRead() Dim buf As String On Error GoTo ErrTrap1 Open myFile For Input As #1 RichTextBox1.Text = "" While Not EOF(1) Line Input #1, buf RichTextBox1.Text = RichTextBox1.Text & buf & Chr(13) & Chr(10) Wend Close #1 Exit Sub ErrTrap1: MsgBox Err.Description Err.Clear End Sub