Excel VBA こういう関数を作りたい

質問

Excel VBAにてこういう関数を作りたいのです。

SInstr(検索する文字列,検索する文字,何番目)

INSTRでは一番最初の位置しか返してもらえないので、任意の見つかった場所の位置を返して欲しいのです。

例:
SInstr("あいうえおかうえきうえ","うえ",3)
10を返す

2つめくらいのならinstrで見つかった場からネストして+1すればいいんですが、4つめ,5つめという物もあるのです。

当方頭が悪いので思いつきませんでした。
頭の良い方、どういう関数を書いていいか教えていただけないでしょうか？

回答No.3

real beatin（@realbeatin） · ベストアンサー

こんにちは。お邪魔します。

２例でお応えします。
関数名をご指定のもので揃えましたから、どれかひとつしか使えません。
複数の関数を同時に試したい時は、個々のプロシージャ単位で、
プロシージャ内にある関数名を全置換してから、
新しい関数名を呼ぶようにしてください。
以下に書くものは、
「特定の文字列を使えない」ような制約がありません。
検索結果として見つからないのであれば、#N/A エラーを返します。
もし、他の値を返したい場合は、CVErr(xlErrNA)を書換えて下さい。

と、ここまで書いていて気が付いたのですが、
おもとめの関数は、
ワークシート上で用いるユーザー定義関数でしょうか？
それとも、ＶＢＡプロジェクト内でCallされる関数でしょうか？
取り敢えず、ワークシート用ユーザー定義関数として書いてあります（※）。
もし、その必要がないようであれば、
以下、As Variant の部分を As String や As Long 等、
適宜書き換えてあげて下さい。

■置換を用いる方法　　簡易版
ワークシート関数のSUBSTITUTE関数等で、
[何番目]に当たる検索文字列だけを一旦置換しておいて、
置換後の文字列をInstr関数で探します。
この場合、置換後の文字列には、
（※）セルの値として決して使われることのない文字列値
（例ではキャリッジリターン）を使う必要があります。

' ' =======================
Public Function SInstr(ByVal 検索対象 As Variant, _
　　　　　　　　　　　　ByVal 検索文字列 As Variant, _
　　　　　　　　　　　　ByVal 何番目 As Variant _
　　　　　　　　　　　　) As Variant
　　検索対象 = WorksheetFunction.Substitute(検索対象, 検索文字列, String(Len(検索文字列), vbCr), 何番目)
　　SInstr = InStr(検索対象, vbCr)
　　If SInstr = 0 Then SInstr = CVErr(xlErrNA)
End Function
' ' =======================

■InStrを繰り返し用いる方法
文字列を置換する処理は時間食うので、
処理を軽くしたい場合には、Instr関数で統一します。
（※）現代のユーザー定義関数は、旧バージョンのExcelと比較して、
ワークシート関数との相対的な処理速度が低くなりましたので
少し意識しました。

' ' =======================
Public Function SInstr(ByVal 検索対象 As Variant, _
　　　　　　　　　　　　ByVal 検索文字列 As Variant, _
　　　　　　　　　　　　ByVal 何番目 As Variant, _
　　　　　　　　　　　　Optional ByVal 開始位置 As Long = 1, _
　　　　　　　　　　　　Optional ByVal 文字比較 As VbCompareMethod = vbBinaryCompare _
　　　　　　　　　　　　) As Variant
Dim i As Long
Dim nPos As Long
Dim cnt As Long
　　nPos = 開始位置 - 1
　　Do
　　　　nPos = InStr(nPos + 1, 検索対象, 検索文字列, 文字比較)
　　　　If nPos Then
　　　　　　cnt = cnt + 1
　　　　Else
　　　　　　Exit Do
　　　　End If
　　Loop While cnt < 何番目
　　If cnt = 何番目 Then
　　　　SInstr = nPos
　　Else
　　　　SInstr = CVErr(xlErrNA)
　　End If
End Function
' ' =======================

お礼

お礼が遅れて申し訳ありません。
たいへんわかりやすく丁寧な説明で、また実用的にも十分な物でした。
同じ物を作ろうとしてもなかなか難しいのでそのままコピペで使わせてもらいました。
本当にありがとうございました。Thanks!!

補足

非常に詳しくいただきありがとうございます。
しばらくにらめっこしながら参考にさせていただきます。
また改めてお礼させていただきます。

回答No.5

real beatin（@realbeatin）

＃３です。

ＶＢＡ用、ということでしたら、
私の答はひとつ、です。
引数指定する文字列に対する制限（例えば、スペースや改行が扱えない）
は、ありません。
パフォーマンス的にも（VBAで作成したものとしては）負荷は小さいです。
もし永く使いたいのであれば、アドインとして保存・登録した方が動作が軽くなります。
ユーザー定義関数としてワークシート上でも流用できますが、
Variant方を使う、キチンとエラー値を返す、という方向で書いた方が、
シート上では扱い易いです。

■以下は、VBA.Instr関数の機能拡張版という意図で書いています。
見つからない場合は、0 値を返します。

' ' =======================
Public Function SInstrA(ByVal Source As String, ByVal Search As String, _
　　　　　　　　　　　　ByVal NumOrder As Long, Optional ByVal Start As Long = 1&, _
　　　　　　　　　　　　Optional ByVal Compare As VbCompareMethod = vbBinaryCompare _
　　　　　　　　　　　　) As Long
Dim nPos As Long
Dim cnt As Long
　　nPos = Start - 1
　　Do
　　　　nPos = InStr(nPos + 1, Source, Search, Compare)
　　　　If nPos Then
　　　　　　cnt = cnt + 1
　　　　Else
　　　　　　Exit Do
　　　　End If
　　Loop While cnt < NumOrder
　　SInstrA = nPos
End Function
' ' =======================

回答No.4

山田 太郎（@f_a_007）

Public Function SInstr(ByVal Text1 As String, ByVal Text2 As String, ByVal N As Integer) As Integer
　　SInstr = InStr(1, Replace(Text1, Text2, Space(Len(Text2)), , N - 1), Text2)
End Function

スペースに置換する数の指定を間違っていました。

＞検索文字を同じ個数のスペースに置換！

当たり前のことが・・・。

回答No.2

山田 太郎（@f_a_007）

＞当方頭が悪いので思いつきませんでした。

頭の良し悪しは関係ないと思うが・・・。単なる発想の問題だから・・・。

Public Function SInstr(ByVal Text1 As String, ByVal Text2 As String, ByVal N As Integer) As Integer
ON Error Resmu Next
　　SInstr = InStr(1, Replace(Text1, Text2, Space(N - 1), , N - 1), Text2)
End Function

テストは3つのみ。だから、完全版と言い難いが・・・。こんな感じで・・・。

お礼

短くてわかりやすいです。
ありがとうございます。

回答No.1

Chiquilin

関数をいちいち作らないといけない理由があるのですか？

=FIND("♪",SUBSTITUTE("あいうえおかうえきうえ","うえ","♪",3))

お礼

worksheetfunction使ったら簡単ですね。
他でも応用したいので。