マクロで左から一文字を取得する方法

このQ&Aのポイント
  • Win 7 Excel 2010のユーザーフォームで住所録を作成しています。textBox1に「会社名」、textBox2に「読み」を入力し、セルに転入するマクロを記述しています。しかし、textBox3で「タナカススム」の左の一文字「タ」を取得する方法がわかりません。ご指導願えませんでしょうか。
  • '読み'ボタンをクリックすると、textBox2に入力された会社名のふりがなを取得し、半角文字に変換してtextBox3に表示するマクロが記述されています。
  • '会社名'テキストボックスからフォーカスが移った時に、入力された会社名のふりがなを取得し、半角文字に変換してtextBox2に表示するマクロもあります。
回答を見る
  • ベストアンサー

マクロで左から一文字を

いつもお世話になります。 Win 7 Excelll 2010 です。 現在ユーザーフォームで住所録を作成中です。 textBox1 に「会社名」 日本    セルに転入 textBox2 に「読み」   ニホン   セルに転入 というマクロを記述していますがこの時、 タナカ ススム の左の一文字 「タ」をtextBox3で取りたいのですが textBox3にはどんなマクロを記述すればいいかご指導願えませんでしょうか。 ※念のためtextBox2のマクロはそのままにしておきたいです。 textBox2には下記のマクロです。 '[読み]ボタンクリック時の処理 Private Sub cmdYomi_Click() Dim Ret As Long Dim strPhonetic As String '会社名が入力されていない場合にはプロシージャを抜ける If textKaisha.Value = "" Then Exit Sub 'ふりがなの第一候補を取得 strPhonetic = Application.GetPhonetic(textKaisha.Value) Do '取得したふりがなの候補で確定するかどうかをメッセージボックスで確認 Ret = MsgBox(strPhonetic & vbCrLf & vbCrLf & _ "確定しますか?", vbYesNoCancel) If Ret = vbYes Then '確定の場合には半角文字に変換してテキストボックスに格納 textYomi.Value = StrConv(strPhonetic, vbNarrow) ElseIf Ret = vbNo Then '[いいえ]ボタンを選択した場合は、次のふりがな候補を取得 strPhonetic = Application.GetPhonetic() '次の候補がなければループをぬける If strPhonetic = "" Then MsgBox "次の候補はありません" Exit Do End If End If 'ふりがな候補確定、またはキャンセルの場合は、ループを抜ける Loop While Ret = vbNo End Sub '[会社名]テキストボックスから他へフォーカスが移ったときの処理 Private Sub textKaisha_Exit(ByVal Cancel As MSForms.ReturnBoolean) Dim strTemp As String If textKaisha.Value <> "" Then 'ふりがなの第一候補を取得 strTemp = Application.GetPhonetic(textKaisha.Value) 'ふりがなを半角文字に変換して[会社名よみ]テキストボックスへ格納 textYomi.Value = StrConv(strTemp, vbNarrow) End If End Sub

質問者が選んだベストアンサー

  • ベストアンサー
  • bin-chan
  • ベストアンサー率33% (1403/4213)
回答No.1

テキスト3に記述だと難しいのでは? テキスト2のChangeイベントに、 Text3=left (text2,1) を書けば良いと思います

dorasuke
質問者

お礼

早速ご回答いただきありがとうございました。 うまくいきました。

関連するQ&A

  • マクロにおける条件文の作成の件

    以下の様に条件付きの計算式を作成しました。CommandButton3を押しても 計算しなかったり、TextBox3.Value > TextBox1 ではないときでもエラー メッセージが出ます。どこに欠点があるのか教えて下さい。 Private Sub CommandButton3_Click() Dim row As Integer If TextBox1.Value = Empty Then MsgBox ("Aが空欄です") Exit Sub End If If TextBox2.Value = Empty Then MsgBox ("Bが空欄です") Exit Sub End If If TextBox3.Value = Empty Then MsgBox ("Cが空欄です") Exit Sub End If If TextBox4.Value = Empty Then MsgBox ("Dが空欄です") Exit Sub End If If TextBox3.Value > TextBox1.Value Then MsgBox ("Cの値をAの値より小さくしましょう!") Exit Sub End If If TextBox4.Value > TextBox2.Value Then MsgBox ("Dの値をBの値より小さくしましょう!") Exit Sub End If TextBox5 = Round(TextBox1 * TextBox2 - (TextBox1 - TextBox3) * (TextBox2 - TextBox4) / 2, 0) End Sub

  • エクセルマクロ セル内の値の抜き出しと入力の値との

    すみません、ハマっております。 下記マクロにて、A2セル内にある(例)「111-22222-5555-666-1」の中のと入力した5555とのマッチングのマクロを作っているのですが、どうしてもA2値がemptyになってしまいうまくマッチングできません。どうしたらよいでしょうか?お力お貸しください。 Private Sub CommandButton1_Click() Unload 番号入力 Dim OdrNum As String If TextBox1.Value = "" Then Exit Sub Else OdrNum = TextBox1.Value While Mid(A2, 11, 4) <> OdrNum '該当番号の欄になるまで不要行削除 If Mid(A2, 11, 4) = "" Then MsgBox "該当番号はありませんでした。" Exit Sub Else End If Rows("2:2").Select Selection.Delete Shift:=xlUp Wend MsgBox "処理終了" End If End Sub

  • If文中のExit Sub

    Dim i As String i = TextBox1.Value If i ="" Then MsgBox "入力なし" Exit Sub End If Exit Subは何の意味が有るのでしょう? Exit Subを調べたり試したりしたのですが、良く、解りません。 宜しくお願い致します。

  • エクセルのマクロでファイルを開く

    エクセルの「ファイルを開く」ダイアログボックスを使用してファイルを開き、その開いたファイルに対してとあるマクロを実行させたいと思っています。 エクセルの「ファイルを開く」ダイアログボックスでパス取得までは理解出来たのですが、その先の処理が分かりません。 「ファイルを開く」と言うのは、「現在アクティブになっているシートにデータを貼り付けて」の処理でも構いません。 Dim Ret As Variant Ret = Application.GetOpenFilename("Excel ブック (*.xls), *.xls, テキストファイル(*.txt),*.txt") If Ret = False Then MsgBox "キャンセルが選択されました。" Exit Sub Else       'ここにRetで取得しているパスのファイルを開いて、sub_WAITのマクロを実行させたいです。 sub_WAIT.Show End If End Sub

  • 12個のCommandbuttonをスマートに

    はじめまして 2003 XP UserFormにCommandbuttonが12個あります。 Private Sub CommandButton1_Click() If Me.MultiPage1.Value = 0 Then TextBox3.Value = TextBox3 & "1" Else: TextBox1.Value = TextBox1 & "1" End If End Sub Private Sub CommandButton2_Click() If Me.MultiPage1.Value = 0 Then TextBox3.Value = TextBox3 & "2" Else: TextBox1.Value = TextBox1 & "2" End If End Sub Private Sub CommandButton3_Click() If Me.MultiPage1.Value = 0 Then TextBox3.Value = TextBox3 & "3" Else: TextBox1.Value = TextBox1 & "3" End If End Sub Private Sub CommandButton4_Click() If Me.MultiPage1.Value = 0 Then TextBox3.Value = TextBox3 & "4" Else: TextBox1.Value = TextBox1 & "4" End If End Sub Private Sub CommandButton5_Click() If Me.MultiPage1.Value = 0 Then TextBox3.Value = TextBox3 & "5" Else: TextBox1.Value = TextBox1 & "5" End If End Sub Private Sub CommandButton6_Click() If Me.MultiPage1.Value = 0 Then TextBox3.Value = TextBox3 & "6" Else: TextBox1.Value = TextBox1 & "6" End If End Sub Private Sub CommandButton7_Click() If Me.MultiPage1.Value = 0 Then TextBox3.Value = TextBox3 & "7" Else: TextBox1.Value = TextBox1 & "7" End If End Sub Private Sub CommandButton8_Click() If Me.MultiPage1.Value = 0 Then TextBox3.Value = TextBox3 & "8" Else: TextBox1.Value = TextBox1 & "8" End If End Sub Private Sub CommandButton9_Click() If Me.MultiPage1.Value = 0 Then TextBox3.Value = TextBox3 & "9" Else: TextBox1.Value = TextBox1 & "9" End If End Sub Private Sub CommandButton10_Click() If Me.MultiPage1.Value = 0 Then TextBox3.Value = TextBox3 & "0" Else: TextBox1.Value = TextBox1 & "0" End If End Sub Private Sub CommandButton11_Click() If Me.MultiPage1.Value = 0 Then TextBox3.Value = TextBox3 & "00" Else: TextBox1.Value = TextBox1 & "00" End If End Sub Private Sub CommandButton12_Click() If Me.MultiPage1.Value = 0 Then TextBox3.Value = TextBox3 & "000" Else: TextBox1.Value = TextBox1 & "000" End If End Sub  これをもっとスマートに出来ないでしょうか? 宜しくお願いします。

  • 変数とループを使ったマクロについて

    恐縮ですが、ご教示をお願い致します。 comboboxの値を空白のtextboxに貼り付けるものです。 本を片手にマクロを作成していたのですが、上手くいかず困っております。 作成したマクロ Private Sub CommandButton100_Click() '入力値のチェック If ComboBox1 = "" Or ComboBox2 = "" Then GoTo 998 '空白ボックスを検索しデータ入力 If TextBox11 = "" And TextBox12 = "" Then TextBox11 = ComboBox1 TextBox12 = ComboBox2 GoTo 999 End If If TextBox21 = "" And TextBox22 = "" Then TextBox21 = ComboBox1 TextBox22 = ComboBox2 GoTo 999 End If If TextBox31 = "" And TextBox32 = "" Then TextBox31 = ComboBox1 TextBox32 = ComboBox2 GoTo 999 End If ↓ ↓  以下50個あります。 ↓ If TextBox501 = "" And TextBox502 = "" Then TextBox501 = ComboBox1 TextBox502 = ComboBox2 GoTo 999 End If 998 MsgBox "入力値に誤りがあります 999 End Sub とてつもなく長くなってしまいました。 変数をループを使って色々やってみたのですが、どうにもならず。。。 簡単に変数及びループを使用して纏める事は出来る物なのでしょうか? よろしくお願いいたします。

  • エクセルマクロ_テキストボックスをシートに反映(その2)

    エクセルマクロ初心者です。(2003使用_ユーザーフォーム) 先ほどは大変お世話になりました。 複数行に応用させようとしたのですが、管理番号が余計に記載(テキストボックス(出荷日など)が空欄であっても、管理番号だけはとられてしまいます)されてしまいます。すみませんが、ご教授よろしくお願いいたします。 リストボックス1のデータは、Sheet1を表示しています。→管理番号はSheet2のA最終行に記載されます。 テキストボックス1(回答日)は、上記の管理番号記載のとなりに、 テキストボックス2(出荷日)は、テキストボックス1記載のとなりに、 ・・・とテキストボックス4(コメント)(これはK列)に1行で記載されます。 ↑ここまでは、教えていただいたので、完璧なのですが、 テキストボックス2~4までの内容を、あと複数行(4件)追加できるように試してみたのですが、空欄であっても管理番号だけは常に記載されてしまいます。 テキストボックス2と5に記載されている場合は、Sheet2に値を反映させるが、空欄の場合は、値を反映させないようにしたいのです。 (Sheet1=データベース) C5   D5 管理番号 品名 アカ12 りんご アオ56 みかん クロ34 なし クロ89 すいか アオ12 もも (Sheet2=入力シート) A(管理番号)    B(回答日)    C(出荷日)   D(数量)     K(コメント) アオ56        8月9日        8月10日      75     送り先の確認 アオ56                    8月11日      80 クロ34        9月4日        9月5日      80 (今回は、2行で作成した場合のマクロを記載しました) Private Sub UserForm_Initialize() With ListBox1 .ColumnWidths = "0;0;50;50" .ColumnCount = 4 .RowSource = "Sheet1!A5:D" & Worksheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Row End With End Sub Private Sub CommandButton1_Click() If TextBox2.Value Then Dim lRow As Long With Worksheets("Sheet2") lRow = .Range("A" & Rows.Count).End(xlUp).Row .Range("A" & lRow + 1).Value = ListBox1.List(ListBox1.ListIndex, 2) If IsDate(TextBox1.Value) Then .Range("B" & lRow + 1).Value = TextBox1.Value End If If IsDate(TextBox2.Value) Then .Range("C" & lRow + 1).Value = TextBox2.Value End If If IsNumeric(TextBox3.Value) Then .Range("D" & lRow + 1).Value = TextBox3.Value End If .Range("K" & lRow + 1).Value = TextBox4.Value End With End If If TextBox5.Value Then Dim llRow As Long With Worksheets("Sheet2") llRow = .Range("A" & Rows.Count).End(xlUp).Row .Range("A" & llRow + 1).Value = ListBox1.List(ListBox1.ListIndex, 2) If IsDate(TextBox5.Value) Then .Range("C" & llRow + 1).Value = TextBox5.Value End If If IsNumeric(TextBox6.Value) Then .Range("D" & llRow + 1).Value = TextBox6.Value End If .Range("K" & llRow + 1).Value = TextBox7.Value End With End If Dim myCtrl As Control For Each myCtrl In Controls If TypeName(myCtrl) = "TextBox" Then myCtrl.Value = vbNullString End If Next End Sub (ユーザーフォーム) リストボックス1=Sheet1のデータを反映 テキストボックス1(回答日) テキストボックス2(出荷日),テキストボックス3(数量),テキストボックス4(コメント)←1件目 テキストボックス5(出荷日),テキストボックス6(数量),テキストボックス7(コメント)←2件目 ↑1件目のみでコマンドボタンを押した場合は、1件目のみの管理番号取得をしたいのです。が今は、2件目が空欄でも管理番号はとられてしまいます。 長くなってしまいすみません。 どなたかご回答いただければ幸いです。よろしくお願いいたします。

  • エクセル VBA OptionButtonからTextBox

    すいません! OptionButtonなら 下記の記述でエラー表示を 簡単にできるのですが これがOptionButtonではなく TextBoxならどのように変化したら 良いのでしょうか? すいません、教えて下さい! Private Sub 記録_Click() Dim i As Integer Dim Cnt As Integer Cnt = 0 For i = 1 To 6 Step 1 If Me.Controls("OptionButton" & i).Value Then Cnt = i Exit For End If Next i If Cnt = 0 Then MsgBox "選択されていません" Exit Sub End If If Me.Controls("Combobox" & Cnt).Value = "" Then MsgBox Me.Controls("OptionButton" & Cnt).Caption & " の内容が選択されていません" Exit Sub End If With 記入フォーム .TextBox5.Value = Me.Controls("OptionButton" & Cnt).Caption .TextBox6.Value = Me.Controls("Combobox" & Cnt).Value End With Unload Me End Sub

  • マクロのフォームから。。。

    マクロのフォームから。。。 マクロのフォームからシートの最終行に入力ができるようにしたいのです。 マクロは下記になります。今の状態ですと、新規入力ボタンを押してデータ登録ボタンを押すと、途中の行に登録がされてしまいます。 暫く考えていましたがどうしてもわからず、また初心者の為できればわかりやすく教えてもらえると幸いです。どうかよろしくお願い致します。 Private Sub CommandButton3_Click() 入力結果 = MsgBox("データを登録しますか", vbYesNo) If 入力結果 = 6 Then If ToggleButton1.Value = True Then 表示行 = Cells(2, 10).Value + 1 Else 表示行 = Cells(1, 10).Value End If If ToggleButton1.Value = True Then データクリア TextBox1.Value = Cells(表示行, 1).Value + 1 Else データ表示 End If 表示行 = Cells(1, 10).Value Cells(表示行, 1).Value = TextBox1.Value Cells(表示行, 2).Value = TextBox2.Value Cells(表示行, 5).Value = TextBox3.Value Cells(表示行, 6).Value = TextBox4.Value Cells(表示行, 7).Value = TextBox5.Value Cells(表示行, 4).Value = ComboBox1.Value If OptionButton1.Value = True Then Cells(表示行, 3).Value = "男" Else Cells(表示行, 3).Value = "女" End If データ表示 End If End Sub ※ 表の範囲:a1:g5(1行目はタイトル) j1:表示行 j2:最終行(counta)

  • Excel 2007 マクロについて

    初心者なりに試行錯誤しながら、チャレンジしています。 B1セルには日付が入力されています。 B1をダブルクリックしたときにUserForm1のTextBox1にその 日付を表示したいのですが上手くいきません。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Range("B1:B15")) Is Nothing Then Exit Sub Cancel = True UserForm1.Show UserForm1.TextBox1.Value = Target.Value Unload UserForm1 End Sub どこをどのように修正したらよろしいでしょうか?

専門家に質問してみよう