エクセルのマクロについて質問です。お気持ちのみですが合計200p程度(一番貢献度大の方最低100p)差し上げます。


次の仕様を満たすマクロを作成して下さい。

1)今、選択しているセルに abc と書いてあります。マクロはこのエクセルファイルと同一階層にある abc(emt).txt を参照します。(文字と数字のアスキーコードのテキストデータです。)
2)そのファイルの中から、x1行の先頭から数えてy1文字目から、それに続くz1文字を取得してきて、マクロ実行時にアクティブだったセルから右に10列のセルに、とってきたz1文字を書きます。(z1文字を取得の途中に、行の最後まで来た場合は、行の最後までを取得します。)
3)同じファイルから、x2行目のy2文字目から続くz2文字を抜き出してマクロ実行時アクティブだったセルから右に10+1列のセルに書きます。
4)同様に、x3,y3,z3・・・x10,y10,z10まで、プログラム
で指定した文字列をとってきてセルに書き込みます。


以上が仕様です。

このマクロを実行した例をコメントに示します。

よろしくお願いします。

回答の条件
  • 1人3回まで
  • 登録:2006/11/14 20:34:12
  • 終了:2006/11/15 19:12:26

ベストアンサー

id:y3kz No.1

y3kz回答回数31ベストアンサー獲得回数92006/11/14 22:48:07

ポイント120pt

以下のマクロでどうでしょうか。

Sub my_read_data()
    Dim x As Variant '条件x(配列)
    Dim y As Variant '条件y(配列)
    Dim z As Variant '条件z(配列)
    Dim oStartCell As Range 'ファイル名を記載したセル
    Dim sTxtPath As String '参照するテキストファイルのパス
    Dim iFileNo As Integer '入出力に使うファイル番号
    Dim sBuf As String 'データ読み取り用バッファ
    Dim lNo As Long '条件の番号(0スタート。)
    Dim i As Long 'ループ変数(行のスキップに使用。)
    
    '条件の設定。(","区切りで追加する。)
    x = Array(2, 1)
    y = Array(14, 8)
    z = Array(10, 100)
    
    '初期設定。
    Set oStartCell = ActiveCell
    sTxtPath = ThisWorkbook.Path + "\" + oStartCell.Value + "(emt).txt"
    iFileNo = FreeFile()
    
    '条件番号"0"から"条件数-1"までループ。
    For lNo = 0 To 1
        'テキストファイルを開く
        Open sTxtPath For Input As #iFileNo
        
        '行読み込み。
        For i = 1 To x(lNo)
            Line Input #iFileNo, sBuf
        Next
        
        '文字列切り出しと書き込み。
        oStartCell.Offset(0, lNo + 10).Value = Mid(sBuf, y(lNo), z(lNo))
        
        'テキストファイルを閉じる。
        Close iFileNo
    Next
End Sub
id:ReoReo7

ありがとうございます。後日実行してみます。

追記:

できました。ありがとうございました。

2006/11/15 19:10:45

その他の回答(1件)

id:y3kz No.1

y3kz回答回数31ベストアンサー獲得回数92006/11/14 22:48:07ここでベストアンサー

ポイント120pt

以下のマクロでどうでしょうか。

Sub my_read_data()
    Dim x As Variant '条件x(配列)
    Dim y As Variant '条件y(配列)
    Dim z As Variant '条件z(配列)
    Dim oStartCell As Range 'ファイル名を記載したセル
    Dim sTxtPath As String '参照するテキストファイルのパス
    Dim iFileNo As Integer '入出力に使うファイル番号
    Dim sBuf As String 'データ読み取り用バッファ
    Dim lNo As Long '条件の番号(0スタート。)
    Dim i As Long 'ループ変数(行のスキップに使用。)
    
    '条件の設定。(","区切りで追加する。)
    x = Array(2, 1)
    y = Array(14, 8)
    z = Array(10, 100)
    
    '初期設定。
    Set oStartCell = ActiveCell
    sTxtPath = ThisWorkbook.Path + "\" + oStartCell.Value + "(emt).txt"
    iFileNo = FreeFile()
    
    '条件番号"0"から"条件数-1"までループ。
    For lNo = 0 To 1
        'テキストファイルを開く
        Open sTxtPath For Input As #iFileNo
        
        '行読み込み。
        For i = 1 To x(lNo)
            Line Input #iFileNo, sBuf
        Next
        
        '文字列切り出しと書き込み。
        oStartCell.Offset(0, lNo + 10).Value = Mid(sBuf, y(lNo), z(lNo))
        
        'テキストファイルを閉じる。
        Close iFileNo
    Next
End Sub
id:ReoReo7

ありがとうございます。後日実行してみます。

追記:

できました。ありがとうございました。

2006/11/15 19:10:45
id:Mook No.2

Mook回答回数1312ベストアンサー獲得回数3912006/11/15 01:30:51

ポイント80pt

一応仕様どおりだと思いますが、御確認ください。

(ただし、指定が範囲がだった場合、エラーを表示するようにしています。)

'-------------------------------------------------------
Sub getData()
'-------------------------------------------------------
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim filePath As String
    filePath = ThisWorkbook.Path & "\" & ActiveCell.Value & "(emt).txt"
    
' --- ファイルの有無を確認
    If Dir(filePath, vbnomal) = "" Then
        MsgBox filePath & "がありません。"
        Exit Sub
    End If

' --- ファイルを配列に読み込み
    Dim fileData As Variant
    fileData = Split(fso.OpenTextFile(filePath).readall, vbNewLine)
    Set fso = Nothing
    
' --- 指定データを読み込み
    ActiveCell.Offset(0, 10).Value = getTextData(fileData, 2, 14, 10)
    ActiveCell.Offset(0, 11).Value = getTextData(fileData, 1, 8, 100)
    ActiveCell.Offset(0, 12).Value = getTextData(fileData, 10, 4, 4)
    ActiveCell.Offset(0, 13).Value = getTextData(fileData, 1, 100, 3)
'    ActiveCell.Offset(0, 14).Value = getTextData(fileData,x5,y5,z5)
'    ActiveCell.Offset(0, 15).Value = getTextData(fileData,x6,y6,z6)
'    ActiveCell.Offset(0, 16).Value = getTextData(fileData,x7,y7,z7)
'    ActiveCell.Offset(0, 17).Value = getTextData(fileData,x8,y8,z8)
'    ActiveCell.Offset(0, 18).Value = getTextData(fileData,x9,y9,z9)
'    ActiveCell.Offset(0, 19).Value = getTextData(fileData,x10,y10,z10)
End Sub

'-------------------------------------------------------
' ファイルから指定データを取得する関数
'-------------------------------------------------------
Function getTextData(fileData As Variant, lineNum As Integer, _
                     startPos As Integer, strLen As Integer) As String
'-------------------------------------------------------
    
' --- 行数のチェック
    If UBound(fileData) + 1 < lineNum Then
        getTextData = "ERROR! No Line " & lineNum
        Exit Function
    End If
    
' --- 指定行の開始位置のチェック
    If Len(fileData(lineNum - 1)) < startPos Then
        getTextData = "ERROR! Short Line " & lineNum
        Exit Function
    End If
    
' --- 指定位置のデータの取得
    getTextData = Mid(fileData(lineNum - 1), startPos, strLen)
End Function
id:ReoReo7

ありがとうございます。後日実行してみます。

追記:

ありがとうございました。できました。

2006/11/15 19:11:23
  • id:ReoReo7
    実行例です。

    今、A43セルにg51と書いてあったとします。
    引数を
    x1=2,y1=14,z1=10、
    x2=1,y2=8,z2=100、
    ・・・
    としてマクロに書きました。

    そしてg51(emt).txtには


    テストです。:23423E-34
    テストです。テストです。:23423E-234 です。
    テストでした。ありがとうございました:code:23432


    というテキストファイルを書き込んでエクセルと同一のフォルダに置きました。

    欲しい実行結果は、マクロを実行したとき
    K43セルに 23423E-234
    L43セルに 23423E-34
    ・・・

    と書き込まれることです。x1などの引数の数字は少し違って指定する必要があるかもしれませんが、後で調節するので大丈夫です。同じ動作が得られれば、アルゴリズムは変更しても大丈夫です。

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

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

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

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません