Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
6200 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【46452】できました！ みどりかなぶん 07/2/3(土) 20:58 お礼[未読]
【46453】Re:できました！ マクロマン 07/2/3(土) 20:59 発言[未読]
【46454】Re:できました！ みどりかなぶん 07/2/3(土) 21:15 発言[未読]
【46455】Re:できました！ ichinose 07/2/3(土) 21:20 発言[未読]
【46564】Re:できました！ みどりかなぶん 07/2/6(火) 21:15 お礼[未読]
【46574】Re:できました！ ichinose 07/2/6(火) 23:32 発言[未読]
【46642】Re:できました！ みどりかなぶん 07/2/8(木) 20:49 お礼[未読]
【46456】Re:できました！ Kein 07/2/3(土) 21:34 回答[未読]
【46567】Re:できました！ みどりかなぶん 07/2/6(火) 21:27 お礼[未読]
【46452】できました！
お礼  みどりかなぶん  - 07/2/3(土) 20:58 -
引用なし
パスワード
   ichinose様、Kein様。
　早速ご回答ありがとうございました。書いてくださったとおりにやってみたらうまくいきました！お礼が送れて失礼しました。ichinose様が教えてくださったのは私のやり方を元にしておられたのでどこが問題だったのかわかりました。ただセルが多いためか？入力しようとすると砂時計と白十字が交互に出て確定に時間がかかります。回避する方法はあるでしょうか？Kein様はシート全体に通じるやりかたを考えてくださったと思いますが、一部半角のカタカナにしたいときはどのように変えればよいのでしょう？再々お手数ですがお教えください。よろしくお願い致します。
【46453】Re:できました！
発言  マクロマン  - 07/2/3(土) 20:59 -
引用なし
パスワード
   別スレッドにしないで、元のスレッドに
続けて書き込みましょう。
【46454】Re:できました！
発言  みどりかなぶん  - 07/2/3(土) 21:15 -
引用なし
パスワード
   すみません。次回からそうします。
【46455】Re:できました！
発言  ichinose  - 07/2/3(土) 21:20 -
引用なし
パスワード
   ｈｔｔｐ://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=46399;id=excel

これですね！！

'========================================================================
Sub test3()
　　 Dim idx As Long, jdx As Long
　　 Dim rarray As Variant
　　 rarray = Range("a1:a3").Value
　　 Dim mycl As Variant
　　 For idx = LBound(rarray, 1) To UBound(rarray, 1)
　　　　For jdx = LBound(rarray, 2) To UBound(rarray, 2)
　　　　　rarray(idx, jdx) = StrConv(rarray(idx, jdx), vbKatakana)
　　　　　Next
　　　　Next
　　 Range("a1:a3").Value = rarray
End Sub

セル範囲の値を配列変数に格納し、カタカナ変換した後、再び元のセルに戻す

という方法です。

これだと、少しは速くなると思いますよ。
【46456】Re:できました！
回答  Kein  - 07/2/3(土) 21:34 -
引用なし
パスワード
   >一部半角のカタカナにしたい
"シート全体どこでも"ではなくて"目的のセル範囲だけ"でイベントが発生
するようにしたいなら・・

Private Sub Worksheet_Change(ByVal Target As Range)
　 Dim MySt As String

　 If Intersect(Target, Range("B2:B100, E2:E50")) Is _
　　 Nothing Then Exit Sub
　 With Target
　　　If .Count > 1 Then Exit Sub
　　　If IsEmpty(.Value) Then Exit Sub
　　　If IsNumeric(.Value) Then Exit Sub
　　　MySt = .Text
　 End With
　 Application.EnableEvents = False
　 On Error Resume Next
　 Target.Value = StrConv(MySt, vbkatakana)
　 Application.EnableEvents = True
End Sub

などとすれば B2:B100 と E2:E50 の範囲内のみ、カタカナに変えるように
なります。
【46564】Re:できました！
お礼  みどりかなぶん  - 07/2/6(火) 21:15 -
引用なし
パスワード
   ▼=================================================================
>Sub test3()
>　　 Dim idx As Long, jdx As Long
>　　 Dim rarray As Variant
>　　 rarray = Range("a1:a3").Value
>　　 Dim mycl As Variant
>　　 For idx = LBound(rarray, 1) To UBound(rarray, 1)
>　　　　For jdx = LBound(rarray, 2) To UBound(rarray, 2)
>　　　　　rarray(idx, jdx) = StrConv(rarray(idx, jdx), vbKatakana)
>　　　　　Next
>　　　　Next
>　　 Range("a1:a3").Value = rarray
>End Sub

>ichinoseさま、

>再々ありがとうございます。教えてくださった上記の方法で各段に早くなりました。このとき、別のセル例えばb1:b3には半角のカタカナで入れるのはどうしたらよいのでしょう？新しく配列を宣言したり付け足したりしてみましたがうまくいきませんでした｡
【46567】Re:できました！
お礼  みどりかなぶん  - 07/2/6(火) 21:27 -
引用なし
パスワード
   ・
>
>Private Sub Worksheet_Change(ByVal Target As Range)
>　 Dim MySt As String
>
>　 If Intersect(Target, Range("B2:B100, E2:E50")) Is _
>　　 Nothing Then Exit Sub
　　end if
>　 With Target
>　　　　　　MySt = .Text
>　 End With
>　 Application.EnableEvents = False
>　 On Error Resume Next
>　 Target.Value = StrConv(MySt, vbkatakana)
>　 Application.EnableEvents = True
>End Sub
>
>Keinさま、
再々ありがとうございます。
教えていただいた方法を少し省略してやってみてうまくいきました。このとき別のセルたとえばs2:s100までは半角のカタカナにするにはどうしたらよいのでしょう。ずいぶん考えたのですがわかりませんでした。
【46574】Re:できました！
発言  ichinose  - 07/2/6(火) 23:32 -
引用なし
パスワード
   ▼みどりかなぶん さん：
こんばんは。


>>Sub test3()
>>　　 Dim idx As Long, jdx As Long
>>　　 Dim rarray As Variant
>>　　 rarray = Range("a1:a3").Value
>>　　 Dim mycl As Variant
>>　　 For idx = LBound(rarray, 1) To UBound(rarray, 1)
>>　　　　For jdx = LBound(rarray, 2) To UBound(rarray, 2)
　　　　　　rarray(idx, jdx) = StrConv(rarray(idx, jdx), _
　　　　　　　　　　　　　　　　 vbKatakana + vbNarrow)
>>　　　　　Next
>>　　　　Next
>>　　 Range("a1:a3").Value = rarray
>>End Sub

StrconvのHelpで確認してください。
【46642】Re:できました！
お礼  みどりかなぶん  - 07/2/8(木) 20:49 -
引用なし
パスワード
   ▼ichinose さん：


ichinase様、
お返事ありがとうございます。教えていただいた方法を元に別の変数を加えてそれに
for以下のコードを足して

　　　　　For pdx = LBound(myray, 1) To UBound(myray, 1)
>>>　　　　For qdx = LBound(myray, 2) To UBound(myray, 2)
>　　　　　　myray(pdx, qdx) = StrConv(myray(pdx, qdx), _
>　　　　　　　　　　　　　　　　 vbKatakana )
>>>　　　　　Next
>>>　　　　Next

その部分を"b1:b3"に移るようにしてうまくいきました。以前は

　Range("a1:a3").Value = rarray　　　　の前にfor以下のコードを入れたので全部
同じになってしまったようです。時間がかかりましたがやっとできました。わからないところ、できないところが勉強になりました｡kein様のやり方はどう変えればいいかまだ解らないのですが気長に試してみます。お世話になりました｡
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
6200 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free