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

エクセルのセル内の文字列操作マクロをお願いします。

エクセルのあるセルに、全角分で5000字程度の説明文があります。

例・これは■■商品名は?[みかん][りんご]□□です。送料は■■送料は?[500][800][1000]□□です。

そのセルにカーソルをおいてマクロをかけると、インプットBOXで
商品名は?
[みかん]
[りんご]
その他→

と、カッコ内にあるものが順番に並び、選べる様にして下さい。選んだら次の選択にうつります。該当しなければ、その他のボックス内に言葉を入力できるとします。キャンセルボタンもお願いします。

完成・これはみかんです。送料は800円です。

となるようにしてほしいのです。

■■が文字列変換の合図で、■■に次ぐ文字が選択肢の見出し、□□がその欄の終わりの合図としたいのです。[]はできるだけ多く対応してくれると嬉しいです。

よろしくお願いいたします。


●質問者: naranara19
●カテゴリ:コンピュータ 科学・統計資料
✍キーワード:BOX うつ みかん りんご インプット
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● うぃんど
●70ポイント ベストアンサー

この部の「コメント・トラックバックを表示する」にチェックが入っていないため細かな点を相談できず、直接作って見ました

選択と入力のどちらでも1回で操作できるようにしようとすればフォームを作らなければならず面倒ですし、その結果、思惑と違うと言われると立つ瀬もなくなるので、今回は文字列の切り出しを焦点と捕らえることとし選択はInputBoxのみで行えるようにしてあります(そのため、その他を入力するには1ステップ余分にかかります)

結果をどこに書き出すか不明のため、とりあえずmsgboxで出力してます

Option Explicit

Sub Macro1()
 Const startDelimiter = "■■"
 Const stopDelimiter = "□□"
 Const choicesStartDelimiter = "["
 Const choicesStopDelimiter = "]"

 Dim readText As String, outputText As String
 Dim startDelimiterLength As Long, stopDelimiterLength As Long, startPosition As Long
 Dim selectList() As String, selectListVount As Long, inputboxText As String, selectNo As Long, inputStr As String
 Dim regExp As Object, regExpMatches, regExpMatche
 Dim i As Long, err As Long
 
 startDelimiterLength = Len(startDelimiter)
 stopDelimiterLength = Len(stopDelimiter)
 startPosition = 1
 
 readText = ActiveCell.Value
 outputText = ""
 
 Set regExp = CreateObject("VBScript.RegExp")
 With regExp
 .pattern = startDelimiter & ".+?" & stopDelimiter
 .IgnoreCase = True
 .Global = True
 Set regExpMatches = .Execute(readText)
 Debug.Print outputText
 For Each regExpMatche In regExpMatches
 With regExpMatche
 selectList = Split(Replace(Mid(.Value, startDelimiterLength + 1, .Length - startDelimiterLength - stopDelimiterLength), choicesStopDelimiter, ""), choicesStartDelimiter)
 inputboxText = selectList(0)
 selectListVount = UBound(selectList)
 For i = 1 To UBound(selectList)
 inputboxText = inputboxText & vbCrLf & i & " : " & selectList(i)
 Next i
 inputboxText = inputboxText & vbCrLf & i & " : その他を手入力"

 err = 3: 'エラー上限
 Do
 selectNo = Application.InputBox(Prompt:=inputboxText, Title:="数値を入力してください", Type:=1)
 If selectNo = False Then Exit Sub
 If selectNo > 0 And selectNo <= UBound(selectList) Then
 outputText = outputText & Mid(readText, startPosition, .FirstIndex - startPosition + 1) & selectList(selectNo)
 startPosition = .FirstIndex + .Length + 1
 Exit Do
 ElseIf selectNo = UBound(selectList) + 1 Then
 inputStr = Application.InputBox(Prompt:=selectList(0), Title:="数値/文字を入力してください", Type:=2)
 If inputStr = "False" Then Exit Sub
 outputText = outputText & Mid(readText, startPosition, .FirstIndex - startPosition + 1) & inputStr
 startPosition = .FirstIndex + .Length + 1
 Exit Do
 Else
 err = err - 1
 If err = 0 Then MsgBox "エラー回数上限を超えましたのでマクロは停止します": Exit Sub
 End If
 Loop
 End With
 Next
 End With

 MsgBox outputText & Mid(readText, startPosition)
End Sub
◎質問者からの返答

すごくうれしいご回答に感謝します。

この部の「コメント・トラックバックを表示する」にチェックが入っていないため細かな点を相談できず、直接作って見ました

↑すみませんでした。よく理解しておりませんでした。


その他を手入力で1ステップとありますが、それで十分です。ご配慮ありがとうございます。

【お願い1】

最後、コメント表示の処理ありがとうございます。ではなく、一度コメント欄にこれで登録しますか?とした時に、OK、キャンセル(一切初めにも戻る)を選べ、その同じセルに上書きという形でお願いできますでしょうか?

【お願い2】

また、コメント欄にすると、5000字もあり、最後のみの表示で全体を確認できませんので、もう少し欄が大きくすることはできますでしょうか?

しかし、思い通りの感じでしっかりと動いてくれて、嬉しいです。

お手数ですが、お時間がすいたときによろしくお願いします。丁寧にマクロをくんでいただいて心より感謝いたします。


2 ● kumi54
●10ポイント

http://home.att.ne.jp/zeta/gen/excel/c04p39.htm

↑ここに載っていますでしょうか。

◎質問者からの返答

ありがとうございます!参考にはなるのですが、マクロをお願いしたいのです。あまり集まりすぎてもいけないので、件数はしぼっていますが、ポイントは良い回答にはしっかりと上乗せしております。

関連質問


●質問をもっと探す●



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