人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

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

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

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

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

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



●質問者: taroemon
●カテゴリ:コンピュータ
✍キーワード:VBA はてな はと エクセル コメント
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● SALINGER
●230ポイント

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

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

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

'ここから実行してください
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
◎質問者からの返答

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

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

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

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ