• ベストアンサー

エクセルVBAで特定の文字を削除したい

選択しているセルの中に入っている文字「■」を 削除したいのですがうまくいきません。 お願いいたします。 Sub ■削除() Dim myRange As Range Dim keyWord1 As String, keyWord2 As String Dim bool As Boolean Set myRange = ActiveCell keyWord1 = "■" keyWord2 = "" bool = myRange.Replace(keyWord1, keyWord2, LookAt:=xlWhole) End Sub

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

  • ベストアンサー
回答No.1

Sub ■削除() 元 = ActiveCell.Value For 検索 = 1 To Len(元) If Mid(元, 検索, 1) <> "■" Then 新 = 新 & Mid(元, 検索, 1) Next ActiveCell.Value = 新 End Sub

value100100
質問者

お礼

早々にありがとうございます。 解決することができました。 これで作業がしやすくなります。

その他の回答 (3)

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.4

Replace利用を、あきらめるつもりはないだろうが、 Basic言語以前からある方法で、下記でもやれるよ。 ーー A列にデータあるとする。B列に結果を置く。 aa▢■sdf   aa▢sdf 大きな池■   大きな池 ■遠い場所   遠い場所 1234■うぇrt   1234うぇrt ■遠い場所■   遠い場所 ーーー 標準モジュールに Sub test01() For i = 2 To Range("a1000").End(xlUp).Row s = Cells(i, "A") p1: p = InStr(s, "■") If p = 0 Then Cells(i, "B") = s GoTo p2 Else s = Mid(s, 1, p - 1) & Mid(s, p + 1, Len(s) - p) End If GoTo p1 p2: Next i End Sub 1セルに2個以上出現分も、削除するようにした テストデータ数が少ないので、いろいろのデータでテストする必要があるが。

value100100
質問者

お礼

ありがとうございました。 問題を解決することができました。 感謝いたします。

  • kkkkkm
  • ベストアンサー率65% (1618/2457)
回答No.3

bool = myRange.Replace(keyWord1, keyWord2, LookAt:=xlWhole) を bool = myRange.Replace(keyWord1, keyWord2, LookAt:=xlPart) に変更して試してみてください。 なお、LookAt:=xlPartは省略可能です。

value100100
質問者

お礼

ありがとうございました。 問題を解決することができました。 感謝いたします。

  • m3_maki
  • ベストアンサー率64% (295/459)
回答No.2

Sub ■削除() ActiveCell = Replace(ActiveCell, "■", "") End Sub

value100100
質問者

お礼

ありがとうございました。 問題を解決することができました。 感謝いたします。

関連するQ&A

  • エクセル 任意の文字をVBAで使いたい時

    Excel VBAで、任意の文字(特定の文字ではなく、何か文字があるという状態)を含んだ語を、置換したいです。 具体的には、「;?」を「; ?」として置換したいです。 ※ここで「?」は任意の文字としています。 以下のコードで試しましたが、うまくいきません。 Sub macro2() Dim myRange As Range Dim keyWord1 As String, keyWord2 As String Dim bool As Boolean Set myRange = Range("C4") keyWord1 = ";?" 'ワイルドカードを使用 keyWord2 = "; ?" bool = myRange.Replace(keyWord1, keyWord2, LookAt:=xlWhole) End Sub keyWord1 = ";?" 、keyWord2 = "; ?"の「" "」の部分に何を入れればいいか、ご教授願います。 宜しくお願い致します。

  • Excelで文字を置換したいのですが

    A列の各セルに入っている文字列において、Bという文字があったらCに、無かったら文字を削除して空白にする、という作業を行いたいのです。 行数にして700行くらいありますので、マクロを考えました。 Replaceメソッドを使うのだと思い、ネットの記事を参考に、以下のマクロを書いてみましたが、「含まない」が機能しません。 「Bを含まない場合は削除する」というのはどのようにしたら良いでしょうか。 Sub macro9() 'Dictionaryオブジェクトの宣言 Dim myDic As Object Set myDic = CreateObject("Scripting.Dictionary") 'Dictionaryオブジェクトの初期化、要素の追加 myDic.Add "*B", "C" myDic.Add "<>B", "" 'Dictionaryオブジェクトを使った複数条件の置換 Dim bool As Boolean, myRange As Range Set myRange = Range("A3:A700") For Each Var In myDic bool = myRange.Replace(Var, myDic(Var)) Next Var End Sub

  • ExcelのVBA ListBox.RowSourceの範囲について教えてください。

    下記のように範囲を変数で検索指定したいのですが、うまくいきません。VBAは初心者です。誰か助けて。 内容は・・・五十音順にあるリストを作り、ウ音のみをListBoxに表示したいのですが。 Private Sub ToggleButton3_Click() Dim A As Range Dim BBB As String Dim C As Range Dim DDD As String Set A = Cells.Find(what:="ウ", lookat:=xlWhole) BBB = Cells(A.row, A.Column + 1).Address Set C = Cells.Find(what:="エ", lookat:=xlWhole) DDD = Cells(C.row - 1, C.Column + 1).Address ListBox商品名.RowSource = "BBB:DDD" End Sub PS 違う方法でもいいのでどなたか教えてください。

  • エクセルVBA 重複を表示したい

    エクセルVBA 重複を表示したい A列で重複すると警告するコードを以下のように作成しました。 これを修正してA列で重複して、なおかつB列でも重複した場合警告するコードにしたいのです。 添付した図では「同姓同名あり、確認してください、鈴木一郎、山口」と表示したいのです。 ご教授よろしくお願いします。 Sub test() Dim myRange As Range Dim 同一flag As Boolean Dim MsgStr As String For Each myRange In Range("A2:A10") If WorksheetFunction.CountIf(Range("A2:A10"), myRange) > 1 Then If 同一flag = False Then 同一flag = True If InStr(1, MsgStr, myRange) = 0 Then MsgStr = MsgStr & myRange & vbCrLf End If End If Next If 同一flag = True Then MsgBox "同姓同名あり" & Chr(13) & _ "確認してください" & Chr(13) & _ vbCrLf & MsgStr Else End If End Sub

  • 特定文がある行を削除

    特定分がある行を削除しようと思い、以下のように設定いたしました。 Sub DelLines() Dim R As Range Do Set R = ActiveSheet.Range("A:A").Find(What:="指定文", LookAt:=xlWhole) If R Is Nothing Then Exit Sub R.EntireRow.Delete Loop End Sub これを、全てのシートに適用するにはどのように書けばよろしいのでしょうか?

  • VBA 特定もセルに入力で実行

    下記のコードを実行した際は問題なく実行されるのですが これを特定のセルに値が入力された際に動かそうとするとエラーになってしまいます。 Sub PaintTargetCharacter() Dim FoundCell As Range, FoundCell2 As Range Dim Addr As String Dim Addr2 As String Dim SearchArea As Range Dim SearchArea2 As Range Application.ScreenUpdating = False ActiveCell.Interior.ColorIndex = 0 '検索対象範囲 Set SearchArea = Worksheets("G番情報").Range("AE6:BG6") '検索実行 Set FoundCell = SearchArea.Find(What:=ActiveCell.Offset(0, -1), LookIn:=xlValues, _ LookAt:=xlPart, MatchCase:=False, MatchByte:=False) '検索文字列を含むセルがない場合は終了 If FoundCell Is Nothing Then Exit Sub Set SearchArea2 = Range(FoundCell.Offset(1, 0), FoundCell.Offset(33, 0)) Set FoundCell2 = SearchArea2.Find(What:=ActiveCell, LookIn:=xlValues, _ LookAt:=xlPart, MatchCase:=False, MatchByte:=False) If FoundCell2 Is Nothing Then Exit Sub FoundCell2.Copy Destination:=ActiveCell Application.ScreenUpdating = True End Sub 当然、特定のセルで値を入力後エンターキーを押すとアクティブセルは下に下がってしまうので Private Sub Worksheet_Change(ByVal Target As Excel.Range) Target.select Call PaintTargetCharacter End Sub としているのですが Set FoundCell = SearchArea.Find(What:=ActiveCell.Offset(0, -1), LookIn:=xlValues, _ LookAt:=xlPart, MatchCase:=False, MatchByte:=False) の部分でエラーが起きてしまいます。 また停止してシートに戻るとセルのカーソル表示が消えてしまいます。 この現象はシートを閉じて再度開くと直りますが なにかエラーと関係しているのでしょうか? 初心者なのでおかしな部分が多々あると思います。 ご指摘などあれば宜しくお願いします。

  • エクセルVBA 重複を表示したい2

    エクセルVBA 重複を表示したい2 以下ではたいへんお世話になりありがとうございました。 http://okwave.jp/qa/q5849885.html 上記に関連する質問をさせていただきます。 下記に提示したコードを修正して、以下のようなコードに変えたいと考えています。 「B列で重複したデータがあれば、そのすべてを左隣のデータと一緒に表示したい」 添付した図だと、 1小沢一郎 7〃 8〃 4鈴木一郎 6〃 以上のような感じです。 アドバイスよろしくお願いします。 Sub TEST() Dim myRange As Range Dim 同一flag As Boolean Dim MsgStr As String m_Rows = Range("b" & Rows.Count).End(xlUp).Row For Each myRange In Range("b2:b" & m_Rows) If WorksheetFunction.CountIf(Range("b2:b4000"), myRange) > 1 Then If 同一flag = False Then 同一flag = True If InStr(1, MsgStr, myRange) = 0 Then MsgStr = MsgStr & myRange.Offset(0, -1).Value & myRange & vbCrLf End If End If Next If 同一flag = True Then MsgBox "同姓同名あり" & Chr(13) & _ "確認してください" & Chr(13) & _ vbCrLf & MsgStr Else End If End Sub

  • エクセルで特定の行をマクロで削除したい。

    Sub DelLines() Dim R As Range Do Set R = ActiveSheet.Range("A:A").Find(What:="ここにキーワード", LookAt:=xlPart) If R Is Nothing Then Exit Sub R.EntireRow.Delete Loop End Sub 上記のソースだと一つのキーワードだけなのですが、複数のキーワードを追加したいのとブック全体(複数のシートから検索)で実行させたいのですが教えていただけませんか?

  • EXCEL 2つの特定の文字列がある行を残して削除

    EXCELにて2つの特定の文字列が含まれる行を残して削除したいと思っております。 A列50行にそれぞれ"年賀状""喪中""名刺"がランダムに羅列されていて、その中から"年賀状"と"喪中"の行だけを残して"名刺"の行は削除したいと思ってます。(B列以降は注文番号、枚数、氏名等が入力されています) 以下のコードで1つだけは可能でしたが、色々試しても2つはできませんでした。(コードは拾い物を少しアレンジ) Sub MacroTest1()   Dim keyWord As Variant   Dim FirstAdd As String   Dim UR As Range   Dim c As Range   Const col As Long = 1 '列数   keyWord = "年賀状"   If VarType(keyWord) = vbBoolean Or Len(keyWord) = 0 Then Exit Sub      With ActiveSheet     With .UsedRange       Set c = .Find( _       What:="*" & keyWord & "*", _       LookIn:=xlValues, _       LookAt:=xlPart, _       SearchOrder:=xlByRows)              If Not c Is Nothing Then         FirstAdd = c.Address         Set UR = c         Do           Set c = .FindNext(c)           Set UR = Union(UR, c)           If c.Address = FirstAdd Then Exit Do         Loop Until c Is Nothing       End If     End With     If Not UR Is Nothing Then       UR.EntireRow.Hidden = True       .UsedRange.SpecialCells(xlCellTypeVisible).Delete       .UsedRange.EntireRow.Hidden = False     End If   End With End Sub どうか宜しくお願いします。

  • LookAt の定数を変数で指定するには?

    エクセルvbaです。 Sub test() Dim strLookAt As String strLookAt = "xlPart" Cells.Replace What:="aaa", Replacement:="iii", LookAt:=strLookAt End Sub このようなことはできないのでしょうか? LookAtの部分のxlWhole または xlPart かをシートから読み取って変数に格納し、 Replace メソッドで置換したいのですが、 このコードを実行すると「型が一致しません」になります。 多分、LookAt:=strLookAtでエラーになってるのだと思います。 String型だからいけないのでしょうか? 回避方法を教えてください。よろしくお願いします。

専門家に質問してみよう