こんにちは、エクセルのVBAについてあまり詳しくないのでお力を貸していただけると幸いです。

具体的にしたいことは、例えばA1からB5までの範囲を選択した後にマクロを実行すると、その全セル内の()を検出し、(いぬ)などの場合には( いぬ )と両側に半角で5つずつのスペースを入れられるようなものは出来ないでしょうか?

また、1つのセル内に、(いぬ)と(ねこ)など()で囲ってあるのものが2つ以上ある場合にも( いぬ )と( ねこ )と働くようなものを作ることは可能でしょうか?

現在は( )、()内にスペースが入力されているものが入力されるマクロを使って、後々その中に手打ちして埋めている状態です。

このQ&Aに関連する最新のQ&A

A 回答 (5件)

こんにちは。



マクロにするというのは、ユーティリティにしたいとおっしゃっていることだと思います。一回きりならともかく、何度も同じようなことが出てくるのを一瞬で変えようとする場合を想定しました。

その場合は、個人用マクロに入れて、ショートカットを設定します。

以下の場合は、正規表現にするのは、もう少し複雑な内容の可能性を想定しているからです。
  .Pattern = "[(\(](.+?)[\) )]"

そのパターンを書き換えさえすれば、いろんな対応が可能です。
また、1つの言葉に対して、スペースが5個ずつでしたら、
c.Value = .Replace(buf, "(" & Space(5) & "$1" & Space(5) & ")")
とすれば、5個になります。

括弧の中の文字を消すとか、簡単にできてしまいます。

c.Value = .Replace(buf, "(" & Space(1) & " " & Space(1) & ")")

また、少し変えることによって、括弧の中に、順に数字を入れて試験問題を作ることなどが可能です。もちろん、文章の中の括弧を意味します。

( 1 )
( 2 )
( 3 )
( 4 )( 5 )
( 6 )( 7 )( 8 )

のようなことも可能です。

'//
Sub EnterSpaces()
 Dim Rng As Range
 Dim RegEx As Object
 Dim buf As String
 Dim Ms As Object, c As Range
 If TypeName(Selection) <> "Range" Then Exit Sub
 Set Rng = Selection
 If Application.CountA(Rng) = 0 Then MsgBox "データがありません", vbExclamation: Exit Sub

 Set RegEx = CreateObject("VBScript.RegExp")
 With RegEx
  .Global = True
  .Pattern = "[(\(](.+?)[\) )]"

  For Each c In Rng
   buf = Replace(c.Value, Space(1), "")
   Set Ms = .Execute(buf)
   If Ms.Count > 0 Then
    '上書きモード
    c.Value = .Replace(buf, "(" & Space(1) & "$1" & Space(1) & ")")
   End If
  Next
 End With
End Sub
    • good
    • 0
この回答へのお礼

大変助かりました。幅広く対応できるもので物凄く感動しました!

お礼日時:2017/04/18 20:09

自分もマクロで処理するよりも「置換」で


 ”(” を ”(     ”
 ”)” を ”     )”
とすることを勧めます。

マクロで行う場合も指定した範囲に対して「置換」をそのまま実行するだけです。
(記録マクロで作れるレベルです)


・・・余談・・・
なぜかこのサイトでは半角スペースを2つ以上続けて入力しても半角スペース1つとして表示されるので、回答には全角スペースを使っています。
他にも、行頭に対しても半角スペースが使えないという制限があるんですよね。

ですので、ここで長く回答されている人は質問文に対して
 「両側に半角で5つずつのスペース」なのに「( いぬ )と( ねこ )」ってどういうこと?
なんて思いません。
安心してください。
(気づいていない人もいる事はナイショ)
    • good
    • 0
この回答へのお礼

置き換えの機能を失念していました…仰るとおり、これでも十分代用できますね。半角のスペースに関しても今後は全角にします。ありがとうございました!

お礼日時:2017/04/18 20:10

>>範囲を選択した後に


これが結構面倒、複数セルがアクティブになっているので、左上先頭位置と列数・行数を取り込み・・・。

エクセルで範囲をマウスで選択して「置換」した方が手っ取り早い。
"(" → "( "へ置換
")" → ") "へ置換

VBAでやらないと、どうしても駄目??
    • good
    • 0

No.1 の追記



もし間違えて同じ箇所を数回やってしまってもスペースは1つだけにしたいのならば以下のようにしてみてください。
--------------------------------------------------------------------------
Sub スペース追加()
Selection.Replace What:="( ", Replacement:="("
Selection.Replace What:="(", Replacement:="( "
Selection.Replace What:=" )", Replacement:=")"
Selection.Replace What:=")", Replacement:=" )"
End Sub
--------------------------------------------------------------------------
    • good
    • 0
この回答へのお礼

大変助かりました。希望の動作をしてくれるもので、感謝しています!

お礼日時:2017/04/18 20:11

置換してしまうのが楽だと思います。

以下のようなものではどうですか?
--------------------------------------------------------------------------
Sub スペース追加()
Selection.Replace What:="(", Replacement:="( "
Selection.Replace What:=")", Replacement:=" )"
End Sub
--------------------------------------------------------------------------
    • good
    • 0

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

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aと関連する良く見られている質問

Q【EXCEL】セル内に、スペースで区切られた二つの情報を、2セルに分離する方法

お世話になります。

一つのセル内に、

"ABC DEF"

のように、スペースで区切られて、二つの情報がある場合に、
その情報を2セルに分離する方法を探しています。

スペースで区切られているものの、
ABC,DEFにあたるセル内の各文字数がばらばらなため、
RIGHT LEFT関数も使えないですし・・・

よろしければ、ご助言、宜しくお願い致します。

Aベストアンサー

メニューの[データ]-[区切り位置]のウィザードを利用するとか。


> スペースで区切られているものの、

でしたら、FIND関数で区切り文字の位置が検索できます。区切り文字が何文字目か分かれば、

> RIGHT LEFT関数

で処理可能です。

Qセルをダブルクリックすると、不特定のフォルダ内にある、セルの値を含む名前のファイルが開くマクロを教えて下さい。

マクロ初心者です。
いろいろ検索してみましたが、見つけられなかったので教えて下さい。

セルをダブルクリックすると、そのセルの値を含むファイルが開くようにしたいのですが、ファイル名はセルの値と完全に一致してはいません。但し、必ずセルの値でファイル名は始まります。
例: セルの値="A"
   開きたいファイル名は= 
"AA 12345987.xls"とか"BCBB 657.xls
開きたいファイルは、C:\ww\001、C:\ww\022、C:\ww\303、、、いずれかのフォルダ内にあります。 C:\wwまでは同じです。

Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, Cancel As Boolean)
を使って、特定フォルダ内にある、セルの値と完全に一致する名前のファイルを開く方法は、検索をくりかえして見つけることができました。

ファイルが存在するパスを特定できず、
ファイル名が、セルの値と完全には一致していないファイルを自動的に開く方法がありましたら、教えて下さい。お願いします。

マクロ初心者です。
いろいろ検索してみましたが、見つけられなかったので教えて下さい。

セルをダブルクリックすると、そのセルの値を含むファイルが開くようにしたいのですが、ファイル名はセルの値と完全に一致してはいません。但し、必ずセルの値でファイル名は始まります。
例: セルの値="A"
   開きたいファイル名は= 
"AA 12345987.xls"とか"BCBB 657.xls
開きたいファイルは、C:\ww\001、C:\ww\022、C:\ww\303、、、いずれかのフォルダ内にあります。 C:\ww...続きを読む

Aベストアンサー

>ファイル名が、セルの値と完全には一致していないファイルを自動的に開く
部分一致しているBookを全て開くと言う事でしょうか?

Qセル内の2行をそれぞれ別のセルにコピーするマクロ

A列にデータが入力されていたとします。
そのデータのうち、複数のセルで改行されて2行になっています。
改行されているセルをサーチし、1行目をB列のセルに、2行目をC列のセルに分割してコピーしたいと思います。

この様な方法は、マクロで可能でしょうか。
適切な関数があれば、ご教授いただきたいと思います。

Aベストアンサー

以下のマクロをVBE画面の標準モジュールにペーストしてください

Sub Macro3()
Dim idxR As Long, resF
Application.ScreenUpdating = False
For idxR = 1 To Range("a65536").End(xlUp).Row
With Cells(idxR, 1)
resF = Application.Find(Chr(10), .Value)
If IsNumeric(resF) Then
.Copy
.Offset(0, 1).Select
ActiveSheet.Paste
End If
End With
Next idxR
Range(Cells(1, 2), Cells(idxR, 2)).TextToColumns _
DataType:=xlDelimited, Other:=True, OtherChar:=Chr(10)
Application.ScreenUpdating = True
End Sub

以下のマクロをVBE画面の標準モジュールにペーストしてください

Sub Macro3()
Dim idxR As Long, resF
Application.ScreenUpdating = False
For idxR = 1 To Range("a65536").End(xlUp).Row
With Cells(idxR, 1)
resF = Application.Find(Chr(10), .Value)
If IsNumeric(resF) Then
.Copy
.Offset(0, 1).Select
ActiveSheet.Paste
End If
End With
Next idxR
Range(Cells(1, 2), Cells(idxR, 2)).TextToColumns _
DataType:=x...続きを読む

QExcelのマクロでセル内の数値によってセルの色分け

はじめまして。マクロ初心者です。
よろしくお願いいたします。

エクセルに入力されている数値によってセルを色分けしたいのです。
数値はこんなふうに入力されています↓

A0*22*33*44
             B1*22*33*44
A2*12*55*66               D1*77*22*88
             C1*12*55*66               E2*99*12*11 

こういったものが全部で1500行ほどです。
*は空白を表しています。
この中の、空白を入れて左から4つめの数字が2、5つめが2のときは赤、
左から4つめの数字が1、5つめの数字が2のときは青、
それ以外のときはそのまま…
といった具合に全部で5種類5色に色分けしたいのですが、どうにも能力が足りなくて困っています。
最初、自分なりにネット等参考にしながら「22という数値を含むセルは赤」といったように作ったのですが、
どうしても左から4文字目5文字目に限定しないと余計なセルにも色が付いてしまうのです。
もう2日も悩んでいますが、どうにも手も足も出ません。
ご指導いただけると本当に助かります。
どうぞよろしくお願いいたします。

はじめまして。マクロ初心者です。
よろしくお願いいたします。

エクセルに入力されている数値によってセルを色分けしたいのです。
数値はこんなふうに入力されています↓

A0*22*33*44
             B1*22*33*44
A2*12*55*66               D1*77*22*88
             C1*12*55*66               E2*99*12*11 

こういったものが全部で1500行ほどです。
*は空白を表しています。
この中の、空白を入れて左から4つめの...続きを読む

Aベストアンサー

こんにちは。

>こういったものが全部で1500行ほどです。
>*は空白を表しています。

間の空白が、半角であり、空白は1つであるという確約はないと思うのですね。
1500行で、数多くある場合は、そういうことを想定しないといけないような気がします。

私のコードの考え方は、空白で仕切られた4つの塊の文字列の2番目が、何であるかを検索しています。

確実に、その場所にあるというなら、
For Each c In rng で、
If Mid(c.Value, 4, 2) = 22 Then とすればよいです。

なお、色は、塗りつぶすなら、Interior の場合は、パステルカラー。Font なら、原色がよいです。

-----------------------------------------------
'Case のところに、数値と色を加えてください。

Sub TestMacro1()
  Dim rng As Range
  Dim c As Range
  Dim buf As Variant
  
  Set rng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)
  Application.ScreenUpdating = False
  rng.Interior.ColorIndex = xlNone
  For Each c In rng.Cells
    '全角スペースを半角にする
    buf = Replace(Trim(c.Value), Space(1), Space(1), , , 1)
    'スペースが2個以上入ったものをひとつにする
    Do While InStr(1, buf, Space(2), 1) > 0
     buf = Replace(buf, Space(2), Space(1), , , vbTextCompare)
    Loop
    If UBound(Split(buf, Space(1))) > 0 Then
      buf = Split(buf, Space(1))
      '数値を探す(ここに入れる)
      Select Case Val(buf(1))
        Case 22: c.Interior.ColorIndex = 3 '赤(3), ローズ(38)-パステルカラー
        Case 12: c.Interior.ColorIndex = 5 '青(5), 水色(34)-パステルカラー
      End Select
    End If
    buf = Empty
  Next c
  Application.ScreenUpdating = True
End Sub

こんにちは。

>こういったものが全部で1500行ほどです。
>*は空白を表しています。

間の空白が、半角であり、空白は1つであるという確約はないと思うのですね。
1500行で、数多くある場合は、そういうことを想定しないといけないような気がします。

私のコードの考え方は、空白で仕切られた4つの塊の文字列の2番目が、何であるかを検索しています。

確実に、その場所にあるというなら、
For Each c In rng で、
If Mid(c.Value, 4, 2) = 22 Then とすればよいです。

なお、色は、塗りつぶすな...続きを読む

Qセル内、スペース位置で改行

宜しくお願いします。

A列に品名があり、途中に半角スペースが有るものと無いものが混在しています。スペースの場所は色々です。
スペースが有るものについて、セル内での改行をしています。(手動)
データ自体が他のシートからのコピー&ペーストのため回数と量が多いのでVBAでの処理をと思ったのですが、改行位置の指定をどうしたらいいのか分かりません。
申し訳ありません、ご教授下さい。

Aベストアンサー

次の記述でいかがでしょう? A列の半角スペースのみ改行に差し替えます。

Sub SPACE_CHANGE()
ActiveSheet.Columns("A").Replace _
 What:=" ", Replacement:=vbLf, _
  SearchOrder:=xlByColumns, MatchCase:=True
End Sub


Win2000+Excel2000で動作確認


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報