アプリ版:「スタンプのみでお礼する」機能のリリースについて

”単語/用例の登録”機能を利用して、”読み”に数字の”1”を登録、”語句”に”炭俵灰之介”を
登録する。このままだと、任意のセルに”1”を入力→スペースキーで変換→ENTERで確定
→ENTERで直下のセルに移動、となりますが、これを、特定のセル範囲、例えば、D5からD10
のみにおいて、1を入力→他の変換候補を表示させることなく、ENTERで確定、同時に直下の
セルに移動できるようにしたいのですが、なにか方法はあるでしょうか。
VLOOKUP関数を使用すると、検索用の数字を入力するセルと、検索結果を表示するセルが
別になり、画面が煩雑に思われるので、このような方法が可能かどうか考えているところですが
検索用の数字を入力するセルと、検索結果を表示するセルを同じにする方法はなにか
あるでしょうか。
ご教授お願いいたします。

A 回答 (4件)

#3、cjです。


> その、すこしが難しい
よくご存じのようで、安心しました。
一応、仕様等私好みで整理してみました。
#好きでやってるので、気にしないで下さいね。あのままじゃ余りにもアレなので。
インデックスをセル値に指定するだけで事足りる話だったなら、それはそれでいいので。

' ' ===ThisWorkbookモジュール===
Option Explicit
' ' ============================ 7767828we2
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  Sheets("Sheet1").FrmTBox.Visible = False '◆ Sheet名を指定
End Sub
' ' ============================

' ' ======Sheet モジュール======
Option Explicit
Private aList ' List配列
Private nUB As Long ' List配列のサイズ
Private n As Long ' List配列用インデックス
Private Const S_REF = "D5:D10" '◆処理対象範囲を参照文字列指定
' ' ============================ 7767828shEv
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Intersect(Target, Range(S_REF)) Is Nothing Or Target.Count > 1 Then
    If FrmTBox.Visible Then FrmTBox.Visible = False
  Else
    Call ActTBox(Target)
  End If
End Sub
' ' ----------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Intersect(Target, Range(S_REF)) Is Nothing Then Exit Sub
  Cancel = True
  Call ActTBox(Target)
End Sub
' ' ============================ 7767828tbEv
Private Sub FrmTBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  With FrmTBox
    Select Case KeyCode
    Case 27: Application.OnTime Now(), Me.Name & ".HideTBox" ' ▼"ESC"
    Case 37: ActiveCell.Offset(, -1).Select ' ▼"←"
    Case 38: ActiveCell(0).Select ' ▼"↑"
    Case 39: ActiveCell(1, 2).Select ' ▼"→"
    Case 40: ActiveCell(2).Select ' ▼"↓"
    End Select
  End With
End Sub
' ' ----------------------------
Private Sub FrmTBox_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error GoTo CrArr_
  nUB = UBound(aList)
On Error GoTo 0
  With FrmTBox
    Select Case KeyCode
    Case 48 To 57, 96 To 105: Call ValVal(n & KeyCode Mod 48) ' ▲"0" To "9", "0" To "9"(NumLockedTenKey)
    Case 107, 187: Call ValVal(n + 1) ' ▲Shift+"+", "+"(TenKey)
    Case 109, 189: Call ValVal(n - 1)  ' ▲"-", "-"(TenKey)
    Case 8: Call ValVal(n \ 10)  ' ▲"BACKSPACE"
    Case 46: Call ValVal(0)  ' ▲"DEL"
    Case 9, 13  ' ▲"TAB", "ENTER"
      If .Value <> "" Then ActiveCell.Value = .Value
      If Shift Then ' "SHIFT"
        ActiveCell(0).Select
      Else
        ActiveCell(2).Select
      End If
    End Select
  End With
  DoEvents
Exit Sub
CrArr_:
  Call SetList
Resume
End Sub
' ' ============================ 7767828subR
Sub SetList() ' ◆ List内容を一次元配列で設定。方法、内容は運用に合わせて適宜。Null値不可。
  aList = VBA.Array(Empty, "炭俵灰之介", "Alfred", "Benjamin", "Charlie", "David", "Edward" _
          , "Frank", "George", "Harry", "Isaac", "Jack", Empty, "King", "London" _
          , "Mary", "Nellie", "Oliver", "Peter", "Queen", "Robert", "Samuel", "Tommy")
End Sub
' ' ----------------------------
Sub ActTBox(Target As Range) ' FrmTBox 初期化 位置設定 表示 等
  n = 0
  With FrmTBox
    .Object.Value = Empty
    .Object.IMEMode = fmIMEModeOff
    .Top = Target(1).Top
    .Left = Target(1).Left
    .Activate
    If Not .Visible Then .Visible = True
  End With
End Sub
' ' ----------------------------
Private Sub HideTBox() ' ESC 処理
  DoEvents: DoEvents
  FrmTBox.Visible = False
  ActiveCell.Activate
End Sub
' ' ----------------------------
Sub ValVal(nn As Long) ' List用インデックス n と FrmTBox.Value の管理
  If nn < 0 Then nn = 0
  n = nn
  With FrmTBox
    If n > nUB Then ' 割り当ての無いインデックスは数値のまま
      .Value = n
    ElseIf n = 0 Then
      .Value = Empty
    ElseIf aList(n) = "" Then
      .Value = n
    Else
      .Value = aList(n)
    End If
  End With
End Sub
' ' ============================
' ' ============================ 7767828prep
Private Sub Prep7767828() ' TextBox 初期設定 利用開始時に一度だけ実行
  With OLEObjects.Add(ClassType:="Forms.TextBox.1")
    With .Object
      .BackColor = &HC0FFFF
      .SpecialEffect = fmSpecialEffectFlat
    End With
    .Height = Range("D5").Height '◆
    .Width = Range("D5").Width '◆
    .Name = "FrmTBox"
    .PrintObject = False
    .Visible = False
  End With
End Sub
' ' ===========================
    • good
    • 0
この回答へのお礼

回答 ありがとうございます
お礼が遅くなり、失礼しました

このマクロは難しすぎます。
でも、最初の行から順に理解していけば、いつかは・・・・

お礼日時:2012/11/03 10:00

' ' =========ThisWorkbookモジュール=========


' ' ※ Sheet名を正しく指定してください ※
Option Explicit
' ' ---------------------------------------- 7767828we1
Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Sheets("Sheet1").OleTxtBx.Visible = False
End Sub
' ' ---------------------------------------- 7767828we2
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  Sheets("Sheet1").OleTxtBx.Visible = False
End Sub
' ' =======以上ThisWorkbookモジュール=======


' ' ============Sheet モジュール============
Option Explicit
Private n As Long
Private aList
' ' ---------------------------------------- 7767828se1
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Intersect(Target, Range("D5:D10")) Is Nothing Or Target.Count > 1 Then ' ◆
    If OleTxtBx.Visible Then
      n = Empty
      OleTxtBx.Visible = False
    End If
  Else
    Call SetTxtBox(Target)
  End If
End Sub
' ' ---------------------------------------- 7767828se2
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Intersect(Target, Range("D5:D10")) Is Nothing Then Exit Sub ' ◆
  Cancel = True
  Call SetTxtBox(Target)
End Sub
' ' ---------------------------------------- 7767828sr
Sub SetTxtBox(Target As Range)  ' TextBox 初期設定
  With OleTxtBx
    .Top = Target(1).Top
    .Left = Target(1).Left
    .Height = Target(1).Height
    .Width = Target(1).Width
    .IMEMode = fmIMEModeOff
    .Value = Empty
    .Activate
    If Not .Visible Then .Visible = True
  End With
End Sub
' ' ---------------------------------------- 7767828te1
Private Sub OleTxtBx_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  If KeyCode = 27 Then  ' "ESC"
    n = Empty
    ' OleTxtBx.Visible = False
    ActiveCell.Activate
  End If
End Sub
' ' ---------------------------------------- 7767828te1
' ' 方向キーなど、未対応のキーがあります。未完成です。
Private Sub OleTxtBx_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  Dim nUB As Long
On Error GoTo CrArr_
  nUB = UBound(aList)
On Error GoTo 0
  With OleTxtBx
    Select Case KeyCode
    Case 48 To 57, 96 To 105  ' 0 To 9, 0 To 9(NumLockedTenKey)
      n = Val(n & KeyCode Mod 48)
      If n > nUB Then
        .Value = n
      ElseIf aList(n) = "" Then
        .Value = n
      Else
        .Value = aList(n)
      End If
    Case 9, 13  ' "TAB", "ENTER"
      n = Empty
      If .Value <> "" Then ActiveCell.Value = .Value
'      ActiveCell.Value = .Value ' ' ←↑ as U like
      If Shift Then ' "SHIFT"
        If ActiveCell.Row = 5 Then .Visible = False ' ◆
        ActiveCell(0).Select
      Else
        If ActiveCell.Row = 10 Then .Visible = False ' ◆
        ActiveCell(2).Select
      End If
    Case 8, 46  ' "BACKSPACE", "DEL"
      n = Empty
      .Value = Empty
    End Select
  End With
  Exit Sub
CrArr_: ' ' 一次元配列を設定します。方法、内容は運用に合わせて適宜。以下↓はダミー。
  aList = VBA.Array(Empty, "炭俵灰之介", "Alfred", "Benjamin", "Charlie", "David", "Edward" _
          , "Frank", "George", "Harry", "Isaac", "Jack", Empty, "King", "London" _
          , "Mary", "Nellie", "Oliver", "Peter", "Queen", "Robert", "Samuel", "Tommy")
Resume
End Sub
' ' ==========以上Sheet モジュール==========


' ' ========初期設定(Sheet モジュール)========
' ' 利用開始時にこのプロシージャだけを貼り付け、一度だけ実行
Private Sub Prep7767828()  ' TextBox 初期設定
  Dim oObj As OLEObject
  Set oObj = Me.OLEObjects.Add(ClassType:="Forms.TextBox.1")
  With oObj
    With .Object
      .BackColor = &HC0FFFF
      .SpecialEffect = fmSpecialEffectFlat
    End With
    .Name = "OleTxtBx"
    .PrintObject = False
    .Visible = False
  End With
End Sub
' ' ============== 初期設定 以上==============

こんにちは。お邪魔します。
アイデアひとつでトライした習作みたいなもの(完全ではない)です。

試す場合の手順
 新規のブックを用意して
 まずSheet1のシートモジュールにSub Prep7767828だけを貼りつけて実行
 Sub Prep7767828はもう不要なので削除
 Sheet1シートモジュールにシートモジュール用コードを貼り付け
 ThisWorkbookモジュールにThisWorkbookモジュール用コードを貼り付け
 名前を付けて保存

"ウィンドウ枠固定"、"フィルター"、"アウトライン"などを常時適用したシート、
セルを隠したり描画位置を遷移させるような機能、
などとの併用は、相性悪い、というか奨められません。
本当はUserFormにした方が動作安定します。

でもまあ、ご要望に近い気はしているので、
試して貰えれば仕様を固める足掛かり程度には役に立つんじゃないかな?と。
    • good
    • 0
この回答へのお礼

回答、ありがとうございます

マクロはどうにも手がつけかねています。
>ご要望に近い気はしているので
はい、これをすこし変えれば、完成しそうですが、その、すこしが難しい。
でも、これを機会にマクロを勉強してみます。

お礼日時:2012/10/28 19:59

表示だけで良いなら、対象セル範囲を選択して右クリックし、「セルの書式設定」から表示形式を「ユーザー定義」にして、種類の欄に「[=1]"炭俵灰之介";[2]"2の時の文字列"」と入力してみてください。

    • good
    • 0
この回答へのお礼

回答、ありがとうございます

さっそく利用してみました。なんだか、拍子抜けするぐらい簡単にできました。
なんでも、やってみなくてはわからない、とはいうものの、教わらなくてはわからないことも
たくさんありますよね。

お礼日時:2012/10/28 19:52

こんばんは。




>D5からD10のみにおいて

これがご相談の核心部分という事ですか?

それならまず、IMEにはそういう器用なマネは出来ません。
またご相談の内容自体はエクセルの「オートコレクト」によって実現可能ですが、こちらも「特定のセル範囲」限定は不可能です。



出来ることその1)
>1を入力→他の変換候補を表示させることなく、ENTERで確定、
>同時に直下のセルに移動できるようにしたい

それがヤリタイ事であるのなら、次のようにしておくと出来ます。
(極めて限定的な機能なので、何でも自由にできるワケじゃありません。という意味です)

手順:
所定のセル範囲を選択
セルの書式設定の表示形式でユーザー定義を選び
[=1]"炭俵灰之介";G/標準
と設定しておく




出来ることその2)
シート名タブを右クリック、コードの表示を選ぶ
現れたシートに下記をコピー貼り付ける

private sub worksheet_change(byval Target as excel.range)
 dim h as range
 on error resume next

 for each h in application.intersect(target, range("D5:D10"))
 if h = 1 then
  h = "炭俵灰之介"
 elseif h = "abc" then
  h = 999
 end if
 next
end sub

ファイルメニューから終了してエクセルに戻る
所定のセルに所定の記入を行う。



#参考
ご相談の書き振りが「1ならこれを記入」しかないので、ハードコードしています。
何か一覧表を別に用意できて、それぞれ対応する言葉に書き換えたいと言いたかったのでしたら、上述のようなマクロをちょっと応用すれば簡単に実現できます。特にフォローはしませんので、必要なら自力で挑戦してみて下さい。
    • good
    • 0
この回答へのお礼

回答 ありがとうございます

出来ることその1)を使わせていただきます。その2)のほうは、マクロの敷居が高くて・・・
でも、マクロを自在に使えれば、市販のソフトに負けないくらいのことができるそうで
マクロを勉強してみます。

お礼日時:2012/10/28 19:49

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!