エクセルVBAについて質問です。


シート名が「はてな」か半角数字(たとえば「09」とか「987」など)の場合、
当該シート内におけるA列の全行にある共通の文字列を
「ももんが」に置換するというマクロを作ってください。

例えばA列には「とびうお01」「とびうお02」「新とびうお」など、
からなず「とびうお」等共通の文字列が入っているので、
「とびうお」という文字列を「ももんが」に置換して
「ももんが01」「ももんが02」「新ももんが」にするということです。
共通する文字列はとびうおに限らないので、
どんな文字列にも対応するよう、マクロで抽出するようにしてください。

なお、下記の点にご留意ください。
①質問者は初心者なので、下記の回答者の方のように、
 それぞれのマクロがどう働くか「’」をもちいて説明してください。
  http://q.hatena.ne.jp/1190870363
②マクロは貼り付けてすぐに動くものをお願いします。
③質問が不明瞭でしたらコメントでご確認ください。

以上、よろしくお願いします。

回答の条件
  • 1人2回まで
  • 登録:2008/01/03 17:23:06
  • 終了:2008/01/04 12:48:16

回答(1件)

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692008/01/03 19:54:37

ポイント230pt

共通する文字列が複数ある場合もありますが、一番長い文字列を「ももんが」に置換します。

考えやすいように、共通する文字列を見つけるマクロ、変更するシートを調べるマクロ、半角数字を調べるマクロと関数を分割しています。

動作確認はしていますが、どこか見落としがあるかもしれませんのでそのときはご指摘くだされば修正します。

'ここから実行してください
Sub Macro1()
    Dim mySheet
    Dim s As String
    Dim i As Long
    
    'For Eachを使ってすべてのシートから一つづつmySheetとして取り出します
    For Each mySheet In Worksheets
        
        '「はてな」か半角数字のときに次に移ります
        If mySheet.Name = "はてな" Or Macro4(mySheet.Name) Then
        
            '共通する文字を見つけます
            s = Macro2(mySheet)
            
            '見つけてきた文字が空白のときは抜けます
            If s <> "" Then
            
                '見つけてきた文字を「ももんが」に置換します
                For i = 1 To mySheet.Range("A65536").End(xlUp).Row
                    mySheet.Cells(i, 1).Value = Replace(mySheet.Cells(i, 1).Value, s, "ももんが")
                Next i
            End If
        End If
    Next
End Sub

'共通する文字を総当り見つけるマクロです
Function Macro2(ByVal mySheet As Object) As String
    Dim sA1 As String    'A1セルの文字列
    Dim s As String
    Dim i, j As Long
    
    'A1セルの文字列を取得
    sA1 = mySheet.Range("A1").Value
    
    'A1セルの長さの文字列から1文字ずつ減らしていきます
    For i = Len(sA1) To 1 Step -1
        
        'A1セルの開始位置を一つづつ増やしていきます
        For j = 1 To Len(sA1) - i + 1
        
            'A1セルから文字列を取り出します。これでA1セルの文字列の全てのパターンが取り出せます
            s = Mid(sA1, j, i)
            
            '取り出した文字列が他の行に存在するかを調べます
            If Macro3(s, mySheet) Then
                Macro2 = s
                Exit Function
            End If
        Next j
    Next i
    Macro2 = ""
End Function

'取り出した文字列が他の行に存在するかを調べます
Function Macro3(s As String, ByVal mySheet As Object) As Boolean
    For i = 2 To mySheet.Range("A65536").End(xlUp).Row
        If InStr(1, mySheet.Cells(i, 1).Value, s) < 1 Then
            Macro3 = False
            Exit Function
        End If
    Next i
    Macro3 = True
End Function

'文字が半角数字かどうかを調べるマクロ
Function Macro4(s As String) As Boolean
    '数字かどうか
    If IsNumeric(s) Then
        '半角にすると変化するか
        If StrConv(s, vbNarrow) = s Then
            Macro4 = True
            Exit Function
        End If
    End If
    Macro4 = False
End Function
id:taroemon

いつもご回答ありがとうございました。

いつも本当に助かります。

完璧にうまくいきました。

2008/01/04 12:47:13
  • id:taroemon
    回答の日本語がおかしいですね。

    「ご回答ありがとうございました。
     いつも本当に助かります。
     完璧にうまくいきました。」

    の間違いです。
    また教えてください。

この質問への反応(ブックマークコメント)

トラックバック

  • VBAのお勉強 Excelの操作などなど simple blog 2008-01-04 14:41:15
    http://q.hatena.ne.jp/1199348584まず、ワークシート名の一覧を取得します。Yahoo!で、「vba excel ワークシート名 取得」で検索すると、http://www.relief.jp/itnote/archives/000960.phpが出てきました。ここに...
「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません