【EXCEL VBA 文字列の抜き出し】文字列の抜き出しをVBAで行いたいのですが行き詰ってしまい

Question

【EXCEL VBA 文字列の抜き出し】

文字列の抜き出しをVBAで行いたいのですが行き詰ってしまいました。

処理としては、下記のようにA1セルに値が入っており
1) 12345678 OOOOOOOO apple and 〜
前から2つ目の空欄以降から3つ目の空欄以降までの文字を抜き出したいです

OOOOOOOOが8文字で固定であれば、Mid関数を使いコードが書けたのですが、抜き出したい文字が8文字の時もあれば10文字の時もあり、どちらにも対応できるようにしようと思うと、どのように関数を組み合わせてVBAを書けばいいのか全くわかりません。

大変お手数ですがどなたかお助けいただけませんでしょうか？

GooUserラック · Accepted Answer

No.2 に対する回答が無いので

☆ Ａ列に上書きする場合
--------------------------------------------------------------------------------
Sub Sample1()
Dim 行 As Long
Dim 作業 As Variant
  For 行 = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    作業 = Split(Cells(行, 1).Value, " ")
    If UBound(作業) >= 2 Then
      Cells(行, 1).Value = 作業(1)
    End If
  Next
End Sub
--------------------------------------------------------------------------------

☆ Ｂ列に結果を書き出す場合
--------------------------------------------------------------------------------
Sub Sample2()
Dim 行 As Long
Dim 作業 As Variant
  For 行 = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    作業 = Split(Cells(行, 1).Value, " ")
    If UBound(作業) >= 2 Then
      Cells(行, 2).Value = 作業(1)
    End If
  Next
End Sub
--------------------------------------------------------------------------------

☆ No.1 の修正版（スペースが２つ未満で「#VALUE!」にならないように修正した物）
--------------------------------------------------------------------------------
Function IntermediateString(文字列 As String)
Dim Tmp As Variant
  Tmp = Split(文字列, " ")
  If UBound(Tmp) >= 2 Then
    IntermediateString = Tmp(1)
  Else
    IntermediateString = ""
  End If
End Function
--------------------------------------------------------------------------------

WindFaller · Answer

こんにちは。

数式の場合は、スペースが2つあると正しく出ませんから、一旦置換しないといけません。
これは、データに信頼できる場合です。
=MID(A1,FIND("^",SUBSTITUTE(A1," ","^",2))+1,FIND("^",SUBSTITUTE(A1," ","^",3))-FIND("^",SUBSTITUTE(A1," ","^",2)))

上記は、エラー処理されていません。

'//標準モジュール
Sub Main() '実行するプログラム
Dim c As Range
For Each c In Range("A1", Cells(Rows.Count, 1).End(xlUp))　'最後尾を探す
If c.Value <> "" Then
　c.Offset(, 2).Value = MidWord(c.Value, 2)　　'オフセット-　Aから右に2－C列
End If
Next
End Sub

Function MidWord(ByVal myTxt As String, ini As Long)
'引数1(myTxt):文字列,引数2(ini):空白の数
　Dim i As Long, j As Long, k As Long
　Dim m As Long, n As Long
　If Len(myTxt) = 0 Then Exit Function
　If InStr(1, myTxt, Space(1), vbTextCompare) = 0 Then Exit Function
　Do
　　myTxt = Replace(myTxt, Space(2), Space(1), , , vbTextCompare)
　Loop Until InStr(1, myTxt, Space(2), vbTextCompare) = 0
　i = 1
　Do
　　j = InStr(i, myTxt, Space(1), vbTextCompare)
　　If k = ini - 1 Then m = j + 1
　　If k = ini Then n = j
　　i = j + 1: k = k + 1
　Loop Until j = 0 Or k = ini + 1
　If n = 0 Then n = Len(myTxt)
　MidWord = Mid(myTxt, m, n - m + 1)
End Function

GooUserラック · Answer

ユーザー定義関数にした理由の１つですが、結果はどこに書き出すのでしょうか？
① 上書きしてしまう（スペースが２つ未満の時はどうするのですか？）
② 隣の列などに結果を書き出す。（どの列にするのか指示してください）
③ その他（具体的に説明してください）

GooUserラック · Answer

ユーザー定義関数を作ってみました。以下を標準モジュールに書き込んでください。
--------------------------------------------------------------------------------
Function IntermediateString(文字列 As String)
Dim Tmp As Variant
  Tmp = Split(文字列, " ")
  IntermediateString = Tmp(1)
End Function
--------------------------------------------------------------------------------
使い方は普通の関数と同じです。
たとえば A1セルに「12345678 OOOOOOOO apple and 〜」とあったら、取り出したいセルに「=IntermediateString(A1)」と式を入れてください。

【EXCEL VBA 文字列の抜き出し】 文字列の抜き出しをVBAで行いたいのですが行き詰ってしまい

No.2 に対する回答が無いので

こんにちは。

ユーザー定義関数にした理由の１つですが、結果はどこに書き出すのでしょうか？

ユーザー定義関数を作ってみました。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

【EXCEL VBA 文字列の抜き出し】文字列の抜き出しをVBAで行いたいのですが行き詰ってしまい