自分の無知ゆえにややこしいので、500ポイント用意しております。


テキストファイルで

123 234 456 789 098 234 555 765
234 567 891 234 123 334
567 891 234 123 234 103 456 871
456 789 123 567 222 356

というように計測データが並んだとき、簡単にエクセルに縦に並べることができないでしょうか?自分はマクロはほぼわかりません。
実際にやりたいのは、簡単に言うと例えば上の2段をX軸座標。下2段をY座標としたいのですが。
現状ではまず上の2段の数字を区切りでEnterをし、テキストファイル上で縦1列にしてからエクセルのシートに貼り付けていますが、データ量が多いので効率が大変悪いです。ちなみに数字と数字の間はおそらくタブ区切りです。

回答の条件
  • 1人50回まで
  • 登録:
  • 終了:2007/01/25 13:48:36
※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

ベストアンサー

id:kn1967 No.9

回答回数2915ベストアンサー獲得回数301

ポイント100pt

複数空白への対応版です。

Sub Macro1()
    Dim S_Read As String
    Dim S_FName As String
    Dim V_DataArray As Variant
    Dim V_Data As Variant
    Dim L_Count As Long
    
    S_FName = "a.txt": 'ファイルはxlsファイルと同じフォルダにあるという前提
    
    Cells.Select: 'アクティブなシートの全体を選択
    Range("A1").Activate: 'セルA1をアクティブにする
    Selection.ClearContents: '全クリア
    
    Open ActiveWorkbook.Path & "\" & S_FName For Input As #1: 'ファイルを開く
      Do Until EOF(1): 'ファイルの最後までループ
        Line Input #1, S_Read: '1行分読み取り
        V_DataArray = Split(S_Read, " "): '区切り文字で分割(タブの場合は" "ではなくvbTab)
                
        L_Count = 0: '有効データのカウンター
        For Each V_Data In V_DataArray: '分割されて出来たデータ分のループ
          If Trim(V_Data) <> "" Then
            ActiveCell.Value = V_Data: 'セルへの書き込み
            ActiveCell.Offset(1, 0).Select: '1つ下のセルへの移動
            L_Count = L_Count + 1: 'カウントアップ
          End If
        Next V_Data: 'Forに戻る
        If L_Count = 2 Then
          ActiveCell.Offset(1, 0).Select:  'データが1行に二個しかなかった場合はもう一つしたのセルへ移動
        End If
      Loop: 'Doに戻る
    Close #1: 'ファイルを閉じる
End Sub

その他の回答8件)

id:taknt No.1

回答回数13539ベストアンサー獲得回数1198

ポイント20pt

http://arena.nikkeibp.co.jp/qa/20060208/115307/

そのままテキストファイルのデータをコピーして エクセルに貼り付けます。

次に、その貼り付けたセルを選択しコピーし

違う場所か違うシートで

右クリック

形式を選択して貼り付け

行列を入れ替える にチェックし

OKとします。

すると横のが縦になりますが、これでどうでしょうか?

id:number5512

 すいません。それですと1段目のデータ2段目のデータの列が出来てしまいます。

 実際には1段から6段までのデータがあり、それを縦一列にしたいのです。

2007/01/25 07:44:12
id:kn1967 No.2

回答回数2915ベストアンサー獲得回数301

ポイント100pt

123 234 456 789 098 234 555 765

234 567 891 234 123 334

567 891 234 123 234 103 456 871

456 789 123 567 222 356

123

234

123

334

567

891

222

356

と一列に並ベたいということであれば、

(1)ExcelではなくWordで開き、

(2)編集→置換 にて

(3)検索する文字列の欄に 区切りの空白部分を入れて、

※区切りの空白部分がタブか空白か判らないのであれば、空白部分を選択してコピーしたものを検索する文字列欄に貼り付けても良いです。

(4)置換後の文字列の欄に ^p を入れ、

※^p は改行を意味します。半角で入れてください。

(5)すべて置換を実行します。

(6)後は、テキストファイルとして保存

※コピーしてExcelに貼り付けてもOK

id:number5512

だいぶ使いやすくなりましたが、欲をいいます。

まず、ワードで開いてマクロを実行することによって、先ほどの処理(置換→テキストファイルに出力)をすることは可能でしょうか?また、改行しているところが空白になるのをつめることは出来ないでしょうか?また、X,Y座標ともにの最後のデータは2つ(他は一行に6つのデータ。合計50のデータ)なのですが、そこで区切りの改行を入れることは可能でしょうか?

2007/01/25 08:42:50
id:Yoshiya No.3

回答回数1047ベストアンサー獲得回数280

ポイント20pt

エディタを使っていますか?

エディタの置換機能を使って、\t(タブ)を\n(改行)に置換すれば、簡単に1行になります。

私が使っているのは「Tera Pad」です。


  • まず、「Tera Pad」をダウンロードして、解凍して下さい。

http://www.vector.co.jp/soft/dl/win95/writing/se104390.html

「ファイルのダウンロード」で「開く」ボタンを押せば自動的に解凍します。

  • 「Tera Pad」を実行して、該当するテキストファイルを読み込ませて下さい。  メニュー(ファイル→開く
  • メニューの(検索→置換)を選んで、置換メニューにします。
  • 検索する文字列は「\t」 置換後の文字列は「\n」にします。
  • オプションの「¥n=改行 ¥t=タブ ¥¥=¥(E)」にチェックを入れます。
  • 全て置換」を押して下さい。 「置き換えますか」というウインドウが表示されますので、「すべて」を押して下さい。
  • これで数字が縦一列に並んだと思います。

後は、別名でセーブした上でエクセルから読み込ませて下さい。


お使いのエディタにも「置換」機能があると思いますので、エディタのヘルプを参考にして同様の処理をしてみて下さい。

id:number5512

同様に出来たのですが、2つ目のコメント欄のようなことは実行不可能でしょうか?

ロガーから出力されたテキストファイルをお見せして説明できればともどかしく思います。

2007/01/25 08:51:39
id:kn1967 No.4

回答回数2915ベストアンサー獲得回数301

ポイント100pt

Wordにはマクロ記録というものがありますので、マクロ記録を開始してから一連の動作を行うだけでマクロが完成します。

(以下、Word2000のマクロ記録で作成したものです。手直ししなければならない部分もありますので参考だけとして、実際にご利用になる分に関しましてはコピペではなくてマクロ記録で作ってください。)

■置換

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

  .Text = " "  

  .Replacement.Text = "^p"

  .Forward = True

  .Wrap = wdFindContinue

  .Format = False

  .MatchCase = False

  .MatchWholeWord = False

  .MatchByte = False

  .MatchAllWordForms = False

  .MatchSoundsLike = False

  .MatchWildcards = False

  .MatchFuzzy = True

End With

Selection.Find.Execute Replace:=wdReplaceAll

空白ではなくタブの場合は

.Text = vbTab

になります。


■保存

ChangeFileOpenDirectory "C:\"

ActiveDocument.SaveAs FileName:="123.txt", FileFormat:=wdFormatText, _

LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _

:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _

SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _

False

保存先フォルダ(例では "C:\")はフルパスで指定し最後が\で終わるようにします。




>空白になるのをつめる

>区切りの改行

Wordでもできますが、そこまでするのであればExcelVBAで『1行読み込んでは分解してセルに書き出し』というマクロを造ったほうが早そうです。

Word/Excelのバージョンを書き込めばコピペで使えるようなマクロを誰かが作ってくれるかもしれませんので、書いておくことをお勧めします。

一人2回までなので、ここまでとなりますが、コメント欄を使えるような設定に変えていただければ、判る範囲では追従していきます。

(質問者さんにはページの下のほうに設定を変えるところが見えているはずですから確認してみてください)

id:number5512

大変ありがとうございます。

バージョンは両方とも2000です。

設定も変更いたしましたので、又何かございましたらお願いします。

2007/01/25 09:37:27
id:ota2244 No.5

回答回数77ベストアンサー獲得回数4

ポイント20pt

単純にテキストファイルの置換ツールを使用されてはいかがでしょうか?


http://www.vector.co.jp/soft/win95/util/se359701.html


これらのツールでTabを改行コードに置き換えることで同様のことが出来ると思います。

id:number5512

すいません。客先がフリーソフトのダウンロード禁止なんで。

2007/01/25 09:39:47
id:taknt No.6

回答回数13539ベストアンサー獲得回数1198

ポイント20pt

エクセルのマクロで やってみました。

Sheet1にそのまま 貼り付けて

Ctrl+q とすれば Sheet2に作成されます。

マクロの使い方は Word等と同じです。


Sub Macro1()

'

' Macro1 Macro

'

' Keyboard Shortcut: Ctrl+q

'

' aが 元 bが作成先になります。

a = "Sheet1"

b = "Sheet2"

e = 1

For c = 1 To 65536

If Cells(c, 1) = "" Then Exit For

For d = 1 To 255

If Cells(c, d) = "" Then Exit For

Sheets(b).Cells(e, 1) = Sheets(a).Cells(c, d)

e = e + 1

Next d

Next c

End Sub

id:number5512

すいません。マクロに関しては超が付く初心者なんでわかりませんでした。

上記のワードでのマクロでは数値と数値の間に2~3つの改行が出来たのですが、一応縦一列にはなりました。

2007/01/25 10:33:17
id:kn1967 No.7

回答回数2915ベストアンサー獲得回数301

ポイント100pt

Excel2000での例です。

6/のtakntさんのほうはテキストファイルをSheet1に開いた状態から始まるものですが、こちらはテキストファイルを読みこんでセルに書き出す方法を取っています。

こちらをさらに改良してファイルオブジェクトを扱えるようにすればファイル選択ダイアログをだしたりするなんて事も可能です。

(ダイアログ等に関しては高度になりますので、今回のところは下記コードの意味をキッチリと理解できるようにがんばってください。)

Sub Macro1()
    Dim S_Read As String
    Dim S_FName As String
    Dim V_DataArray As Variant
    Dim V_Data As Variant
    
    S_FName = "a.txt": 'ファイルはxlsファイルと同じフォルダにあるという前提
    
    Cells.Select: 'アクティブなシートの全体を選択
    Range("A1").Activate: 'セルA1をアクティブにする
    Selection.ClearContents: '全クリア
    
    Open ActiveWorkbook.Path &amp; "\" &amp; S_FName For Input As #1: 'ファイルを開く
      Do Until EOF(1): 'ファイルの最後までループ

        Line Input #1, S_Read: '1行分読み取り
        V_DataArray = Split(S_Read, " "): '区切り文字で分割(タブの場合は" "ではなくvbTab)

        For Each V_Data In V_DataArray: '分割されて出来たデータ分のループ
          ActiveCell.Value = V_Data: 'セルへの書き込み
          ActiveCell.Offset(1, 0).Select: '1つ下のセルへの移動
        Next V_Data: 'Forに戻る

        If UBound(V_DataArray) = 2 Then
          ActiveCell.Offset(1, 0).Select:  'データが1行に二個しかなかった場合はもう一つしたのセルへ移動
        End If

      Loop: 'Doに戻る
    Close #1: 'ファイルを閉じる
End Sub
id:number5512

>Open ActiveWorkbook.Path & "\" & S_FName For Input As #1: 'ファイルを開く]

ここで構文エラーになり直すことが出来ませんがどうすればいいでしょうか。

2007/01/25 12:24:52
id:rikuzai No.8

回答回数1366ベストアンサー獲得回数141

ポイント20pt

色々とやり方がでていますが、関数マニアとして、関数一本でやっつける方法を一つ。

コメント欄に記載されている、

データが6列×9行の50データをひとくくりの一列にするという処理をするとして、


  • Excelの新規ファイルを作成し、便宜上「1」という名前のシートを作成します。
  • ロガーのテキストファイルを開いて、「1」シートに貼り付けます。
  • シートを一枚新規に追加します。これをSheet1とします。
  • Sheet1のA1に下記の数式をコピペしてエンターしてください。

=INDEX('1'!$A:$F,1+(ROW()-ROW(A$1))*9+(ROUNDDOWN((COLUMN()-1)/6,0)),COLUMN()-(ROUNDDOWN((COLUMN()-1)/6,0)*6))

  • Sheet1のA1をコピーして、A1:AX2までを選択して貼り付けます。

これでSheet1に、二列に自動表示されると思うのですが。


尚、

データを貼り付ける「1」シート名は↑の式の「'1'」の1の部分を該当名に変更すれば、

自由に変更できます。

また、二系列以上(2行以上)に変換するときは、そのまま数式をフィルコピーして使えます。



以上ご参考まで。

id:number5512

1列50セルにコピーしたらOKだったのですが、2列25行にコピーすると2列目には0しか出ませんでした。

2007/01/25 11:36:30
id:kn1967 No.9

回答回数2915ベストアンサー獲得回数301ここでベストアンサー

ポイント100pt

複数空白への対応版です。

Sub Macro1()
    Dim S_Read As String
    Dim S_FName As String
    Dim V_DataArray As Variant
    Dim V_Data As Variant
    Dim L_Count As Long
    
    S_FName = "a.txt": 'ファイルはxlsファイルと同じフォルダにあるという前提
    
    Cells.Select: 'アクティブなシートの全体を選択
    Range("A1").Activate: 'セルA1をアクティブにする
    Selection.ClearContents: '全クリア
    
    Open ActiveWorkbook.Path &amp; "\" &amp; S_FName For Input As #1: 'ファイルを開く
      Do Until EOF(1): 'ファイルの最後までループ
        Line Input #1, S_Read: '1行分読み取り
        V_DataArray = Split(S_Read, " "): '区切り文字で分割(タブの場合は" "ではなくvbTab)
                
        L_Count = 0: '有効データのカウンター
        For Each V_Data In V_DataArray: '分割されて出来たデータ分のループ
          If Trim(V_Data) <> "" Then
            ActiveCell.Value = V_Data: 'セルへの書き込み
            ActiveCell.Offset(1, 0).Select: '1つ下のセルへの移動
            L_Count = L_Count + 1: 'カウントアップ
          End If
        Next V_Data: 'Forに戻る
        If L_Count = 2 Then
          ActiveCell.Offset(1, 0).Select:  'データが1行に二個しかなかった場合はもう一つしたのセルへ移動
        End If
      Loop: 'Doに戻る
    Close #1: 'ファイルを閉じる
End Sub
  • id:kn1967
    >数値と数値の間に2~3つの改行が出来た

    (疑問1)数値と数値の間にはタブではなくて複数の空白が入っているということでしょうか?
    (疑問2)空白の個数は全ての場所において同じですか?
    以上、確認してください。


    仮に、空白の個数が全て2つであると仮定すれば
    私のExcelVBAでの回答においては
    V_DataArray = Split(S_Read, " ")
    の部分では空白を二つ入れてください。
  • id:rikuzai
    みなさんマクロを組んだりしておられるので、
    とりあえず関数コピペだけでできるものを投下してみました。
  • id:number5512
    number5512 2007/01/25 11:16:01
    調べたところ、数字間の空白数は2~5といったところで、行の初めにも空白があります。
  • id:rikuzai
    すいません、横に長くではなくて、
    縦に長く、だったんですね。
    ↑の数式でA1:AX2で算出してから、コピー、
    任意の場所に「形式を選択して貼り付け」→「値」と「行列を入れ替える」にチェックしてOK
    で一応縦系列になります。
  • id:number5512
    number5512 2007/01/25 12:31:19
    1と名前をつけたシートにテキストを貼り、sheet1にいきなり縦系列にすることは可能ですか?。
    ちなみに、横二列に上記の関数をコピペしても2列目はやはり0が返ります。
  • id:kn1967
    >構文エラー

    はてなが余計な変換してくれてますね。
    気づきませんでした。

    &amp; となっている二箇所をそれぞれ半角の&に書き換えてください。
  • id:rikuzai
    >1と名前をつけたシートにテキストを貼り、sheet1にいきなり縦系列にすることは可能ですか?

    できないことはないですが、

    >ちなみに、横二列に上記の関数をコピペしても2列目はやはり0が返ります。

    ↑これがこちらの方では再現できません。
    (ちゃんと表示されるのですよ…)
    なので、他の方もあると検証できるとおもうので、
    元データの数字に少し手を加えてあって構いませんので、
    実際のデータをコメント欄に貼りつけていただくことは出来ませんか?
    (空白なども含めてそのまま)
    そのデータで検証してみた上で、縦系列に一発で表示する数式を検討したいと思うのですが。
  • id:number5512
    number5512 2007/01/25 13:23:27
    >kn1967さん

     ありがとうございました。縦一列に理想的な形でデータが並びました。
     最後にもう一点。マクロを実行した際に読み込んだデータを使っていっしょに計算もしたいのですが、Aセル以外の関数を残しておくことは可能でしょうか?
  • id:kn1967
    >Aセル以外の関数

    Cells.Select: 'アクティブなシートの全体を選択
     ↓
    Range("A:A").Select: 'A列を選択

    に変えるとA列だけのクリアになります。
  • id:number5512
    number5512 2007/01/25 13:43:52
    >kn1967さん
    ありがとうございました

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

回答リクエストを送信したユーザーはいません