人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

エクセルのマクロについて質問です。お気持ちのみですが合計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まで、プログラム
で指定した文字列をとってきてセルに書き込みます。


以上が仕様です。

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

よろしくお願いします。

●質問者: ReoReo7
●カテゴリ:コンピュータ ウェブ制作
✍キーワード:10+1 ABC txt X1 X3
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● y3kz
●120ポイント ベストアンサー

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

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
◎質問者からの返答

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

追記:

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


2 ● Mook
●80ポイント

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

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

'-------------------------------------------------------
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
◎質問者からの返答

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

追記:

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

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ