少し長くなってしまいました。A列にデータがあり、C列に結果を出力します。短くするため、データ中には「@」が無いものとして書いています。不都合があれば対応できますが・・・。
セル内に、文字と数値が何個あっても機能するはずです。
最大値が複数ある場合は置換えしません。隣のセルに最大値の個数を表示します。
Sub maxVALstr()
Dim myStr As String 'セルの入力値
Dim pot As Integer '文字カウンタ
Dim elm As String '数値と認識した文字ブロック(ワーク)
Dim maxNum As Long '数値と認識した文字の最大値
Dim maxCot As Integer '最大値の個数
Dim rw As Long '行カウンタ
With Range("A1") 'A列を調べる
While .Offset(rw, 0) <> ""
myStr = .Offset(rw, 0) & " " 'スペースを1つ加えておく
maxCot = 0: elm = "": maxNum = 0
For pot = 1 To Len(myStr) '*** 最大数値を取り出す ***
If InStr("0123456789", Mid(myStr, pot, 1)) Then
elm = elm & Mid(myStr, pot, 1) '数値のみ取り出し
Else
If elm <> "" Then '数値を取り出す
Select Case True
Case maxNum < elm
maxCot = 1: maxNum = elm
Case maxNum = elm
maxCot = maxCot + 1
End Select
elm = ""
End If
End If
Next
'
With Application
myStr = .Substitute(myStr, maxNum, "@") '最大値を置き換える
For pot = 1 To Len(myStr)
If InStr("0123456789", Mid(myStr, pot, 1)) Then
Mid(myStr, pot, 1) = " "
End If
Next
myStr = .Substitute(myStr, "@", maxNum) '最大値を元に戻す
myStr = .Trim(myStr) '余分な空白を除去(ワークシート関数)
End With
.Offset(rw, 2) = myStr
If maxCot > 1 Then .Offset(rw, 3) = "最大値:" & maxCot & "個"
'
rw = rw + 1 '次の行へ
Wend
End With
End Sub
お礼
nishi6さん、早々のご回答本当にありがとうございます。私のわがままなお願いを聞いてくださって恐縮です。早速会社で実行してみたのですが、希望とおりの処理が出来ました。これで業務がとても楽になります。本当にありがとうございました。nishi6さんがこれからお仕事が忙しくなられてしまうということで、あまりご相談に乗っていただけることは少なくなってしまいそうですね。今回の質問で、april21さんにもご回答頂いているのですが、私にとってはお二人とも先生のような親近感を抱いております。(こんなことはお二人にとってはご迷惑だとは思うのですが…)別件なのですが、前回nishi6さんに考えていただいたVBA(2つの表を統合するマクロ:TougouList)なんですが、sheet1,sheet2それぞれの表のA列はソートしておく必要がありますでしょうか?会社の同僚がA列がソートされていない表に対してTougouListマクロを実行した際、うまくいかなかったといっておりましたので、もしお分かりでしたら教えていただけますでしょうか?それそれのA列は「Excel_001」というようなデータが入っております。表によってはその部分がまったくソートされていないものがあります。でもそれはわざとソートしていないのです。業務上その順番がとても重要なのですが、そういうタイプの表に対してTougouListを実行してもうまく処理できますでしょうか?もしかしたら、同僚の操作が悪かったのかもしれません。ただ同僚はマクロを実行する前にそれぞれの表のA列をソートしてから実行したのですが、(その部分はうまく処理できるのですが、2つの表が統合された後にまたもとの順番に戻すことが出来ないといっておりました。)TougouListマクロは本当に私達にはなくてはならないものになっておりますので、さまざまなタイプの表に対応させることが出来ればと思いご質問させていただきました。この質問の場でお伺いするのは気がひけるのですが、折がありましたらお答え頂ければと思います。またまた厄介なことを申しまして申し訳ありませんが、どうぞよろしくお願いいたします。