Excel VBA質問箱 IV

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

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


12541 / 13644 ツリー ←次へ | 前へ→

【9223】セル内情報の分割? どらちゃん 03/11/24(月) 22:08 質問
【9224】Re:セル内情報の分割? Kein 03/11/24(月) 22:30 回答
【9709】Re:セル内情報の分割? どらちゃん 03/12/15(月) 11:31 お礼
【9971】Re:追加で質問です どらちゃん 03/12/26(金) 13:23 質問
【9977】Re:追加で質問です つん 03/12/26(金) 16:29 発言
【9986】Re:追加で質問です Kein 03/12/26(金) 21:50 回答
【10005】Re:追加で質問です どらちゃん 03/12/29(月) 9:09 お礼

【9223】セル内情報の分割?
質問  どらちゃん  - 03/11/24(月) 22:08 -

引用なし
パスワード
   お世話になってます。
教えてください。よろしくお願いします。

例えば、以下のようなデータが入った3つのセルがあるのですが、そのうちアルファベットの部分だけを切り離したいのです。
セル内をそれぞれ頭から検索していき、数字(NUMERIC?)の手前までの位置を取得しておいて、切り離す・・・というかんじかな?と思ったりするのですが、具体的な書き方がわからずうまくいきません。

*******************
aft1.2 2009/5
nfs 2.58% 2009/4/20
noto rekr 10.5 2034/5/11
 ↓
aft
nfs
noto rekr
*******************

VBAでも関数(で可能なのか不明)でも構いません。
どうかよろしくお願いしますm(_ _)m

【9224】Re:セル内情報の分割?
回答  Kein  - 03/11/24(月) 22:30 -

引用なし
パスワード
   切り離してどこへ持っていくのか分からないので、選択した範囲の右隣りの列に
表示するとして・・

Sub Only_AtoZ()
  Dim RExp As Object, Match As Object, Matches As Object
  Dim C As Range
  Dim Str As String
 
  Set RExp = CreateObject("VBScript.RegExp")
  With RExp
   .Pattern = "[a-z]"
   .IgnoreCase = True
   .Global = True
   For Each C In Selection
     If .Test(C.Value) Then
      Str = ""
      Set Matches = .Execute(C.Value)
      For Each Match In Matches
        Str = Str & Match.Value
      Next
      C.Offset(, 1).Value = Str
      Set Matches = Nothing
     End If
   Next
  End With
  Set RExp = Nothing
End Sub

【9709】Re:セル内情報の分割?
お礼  どらちゃん  - 03/12/15(月) 11:31 -

引用なし
パスワード
   お礼が遅くなって申し訳ありませんでした。
教えていただいたものそのままで上手くいきました。

本当にありがとうございました。
また何かありましたらよろしくお願い致します。

【9971】Re:追加で質問です
質問  どらちゃん  - 03/12/26(金) 13:23 -

引用なし
パスワード
   新たな問題があったので、再度お願いします。

以下の3つめの時、「noto rekr」にならず、「notorekr」をつながってしまいます。
*******************
aft1.2 2009/5
nfs 2.58% 2009/4/20
noto rekr 10.5 2034/5/11
 ↓
aft
nfs
noto rekr
*******************

関数matchがよくわからないので、自分で修正ができず申し訳ないのですが
どなたか教えていただけないでしょうか。

【9977】Re:追加で質問です
発言  つん E-MAIL  - 03/12/26(金) 16:29 -

引用なし
パスワード
   どらちゃん さん、keinさんこんにちは
横から失礼します

>以下の3つめの時、「noto rekr」にならず、「notorekr」をつながってしまいます。
>*******************
>aft1.2 2009/5
>nfs 2.58% 2009/4/20
>noto rekr 10.5 2034/5/11
> ↓
>aft
>nfs
>noto rekr
>*******************
>
>関数matchがよくわからないので、自分で修正ができず申し訳ないのですが
>どなたか教えていただけないでしょうか。

私も、VBScript.RegExpは初めて見ました。
http://www.microsoft.com/japan/msdn/columns/scripting/scripting051099.asp
こんなページがありました↑

Keinさんのコードを拝見したら、文字列からアルファベットを抜き出して
まとめて転記するって感じですね。
なので、途中のスペースも無視されてしまってるようです。
もちっと待てば、Keinさんの回答がつくと思いますが、
ちと、別のやりかたを考えてみました。
めっちゃベタなやり方ですが・・・

Sub test2()

  Dim r As Range
  Dim i As Long
  Dim k As Long
  
  For Each r In Selection
  k = 0
    For i = 1 To Len(r.Value)
      If IsNumeric(Mid(r.Value, i, 1)) = False Then
        k = k + 1
      Else
        r.Offset(, 1).Value = Trim(Left(r.Value, k))
        Exit For
      End If
    Next i
  Next r
    
End Sub

最初に数字が来る位置を割り出して、その位置以前の部分を抜き出しって感じです。
数字以外の文字もはぶくなら、NGですね(^^;

【9986】Re:追加で質問です
回答  Kein  - 03/12/26(金) 21:50 -

引用なし
パスワード
   つんさん、フォローをありがとう♪
さて例示のような文字列であれば、先のマクロを

Sub Only_AtoZ()
  Dim RExp As Object, Match As Object, Matches As Object
  Dim C As Range
  Dim Str As String
 
  Set RExp = CreateObject("VBScript.RegExp")
  With RExp
   .Pattern = "[a-z]|\s"
   .IgnoreCase = True
   .Global = True
   For Each C In Selection
     If .Test(C.Value) Then
      Str = ""
      Set Matches = .Execute(C.Value)
      For Each Match In Matches
        Str = Str & Match.Value
      Next
      C.Offset(, 1).Value = Trim(Str)
      Set Matches = Nothing
     End If
   Next
  End With
  Set RExp = Nothing
End Sub

と、修正すれば良いでしょう。ただし

123abc def 10.5 ghi 547

というような文字列では

abc def ghi

という結果になります。これは分割の基準が難しいので、今のところうまいパターン
を見出せません。

【10005】Re:追加で質問です
お礼  どらちゃん  - 03/12/29(月) 9:09 -

引用なし
パスワード
   keinさん、つんさん、

無事解決しました。
助かりました。どうもありがとうございました。

12541 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free