[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『特定の位置にある文字列を取り出したい』（ワニ）
検索で求める答えにたどり着けませんでした。
似た質問があれば誘導おねがいします。
次のようなデータ(10件〜20件)から一部だけを抜き出したいです。
「A事業本部 B事業部 C課 D所属 E担当 (F)」
この中からDだけを抜き出したいです。
データの特徴として、
・A〜Cまでの部署は増減があります。
A事業本部 B事業部 C課 Dグループ E G担当 (F)のような場合は「E」が抽出目的。
・区切りになっているスペースは半角スペース2個、E担当 (F)の()の前だけ半角スペース1個。
（分かりにくいと思うので上の例を選択してみてください）
・Dの次がE担当となるのは決まっている。
=MID(TRIM(A1),FIND("●", SUBSTITUTE(TRIM(A1), " ", "●",LEN(TRIM(A1)) - LEN(SUBSTITUTE(TRIM(A1), " ", ""))-2)),FIND("●", SUBSTITUTE(TRIM(A1), " ", "●",LEN(TRIM(A1)) - LEN(SUBSTITUTE(TRIM(A1), " ", ""))-1)))
とりあえずこんな形で組んでみましたが、結果は「D所属 E担当 (F)」で、Eから後ろを上手く処理できません。
関数ですがエクセル操作に不安がある人も扱うことが判明したので、出来ればVBAに落とし込みたいです。(VBA理解度は解説サイト頼りレベルです)
お手数ですが、知恵をお貸しください。
＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞
1）A列をB列にコピー
2）B列を選択して→データタブ→データツール→区切り位置
3）カンマやタブなどの区切り文字によってフィールドごとに区切られたデータを選んで次へ
4）スペースにチェックを入れて次へ
5）不要な列を選んで、削除するを選んで行く。
6）完了
これで必要なデータが抜き出せます。
この操作を自動で行いたければ、
この操作をマクロの記録でコードに変換するところから始めてみてください。
（まっつわん） 2018/06/21(木) 16:37
G担当 ( の直前に来る文字列を抽出 Gは任意のスペース以外の単・複数文字列 データはA列
ということで
Sub test()
Dim a, i As Long, temp As String
With Range("a1", Range("a" & Rows.Count).End(xlUp))
a = .Value
For i = 1 To UBound(a, 1)
temp = GetBeforeTxt(a(i, 1), "担当")
If temp <> "" Then a(i, 1) = temp
Next
.Columns(2).Value = a
End With
End Sub
Function GetBeforeTxt(ByVal txt As String, myStr As String) As String
With CreateObject("VBScript.RegExp")
.Pattern = "\S+(?= +\S+" & myStr & " *\()"
If .test(txt) Then GetBeforeTxt = .Execute(txt)(0)
End With
End Function
（seiya） 2018/06/21(木) 16:44
まっつわんさん
＞区切り位置での対応方法の提示ありがとうございます。
A事業本部 B事業部 C課 "D所属" E担当 (F)
A事業本部 B事業部 C課 Dグループ "E所属" G担当 (F)
↑区切り位置を使用すると、取り出したい文字列がD列とE列などにバラける場合があるので今回は使用できないんです。
規定の位置にある文字列を取り出す際は活用させていただきます。
seiyaさん
＞実行したところ、目的の形になりました！ありがとうございました！
（ワニ） 2018/06/21(木) 18:24
別内容ですが続けて質問させていただきます。
元々あった他のVBAとseiyaさんのものは速さが段違い（他が遅い）でして
このタイミングで改善できないかと思った次第です。
Sub 会社入力()
Dim ans As String
Dim rng As Range
Range("B1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Offset(1).Resize(Selection.Rows.Count - 1).Select
ans = InputBox("会社名を入力してください。", "会社名入力", "")
For Each rng In Selection
For i = 8 To Cells(Rows.Count, 1).End(xlUp).Row
With rng
.Value = ans & .Value 'この行を修正
End With
Next i
Next
ActiveCell.Select
End Sub
ファイルには他にも全角半角変換のVBAもありますが、基本Range("B1").Select〜で入力済みのセルを取得しています。
動かすと処理！次！処理！次！みたいな動きになりもっさりします。
よろしくお願いいたします。（別で立てたほうがいいなどのご指摘もお待ちしています。）
（ワニ） 2018/06/22(金) 17:00
こういうことですか？
Sub 会社入力()
Dim ans As String, x As Long
x = Range("a" & Rows.Count).End(xlUp).Row - 7
With Range("b2", Range("b2").End(xlDown))
ans = InputBox("会社名を入力してください。", "会社名入力", "")
.Value = .Parent.Evaluate("index(rept(""" & ans & """," & x & ")&" & .Address & ",,)")
End With
End Sub
（seiya） 2018/06/22(金) 18:47
Sub 会社入力2()
Dim Rng As Range
Dim v As Variant
Dim i As Long
Dim s As Long
Set Rng = Range(Range("B2"), Cells(Rows.Count, "B").End(xlUp))
v = Rng.Value
s = InputBox("会社名を入力してください。", "会社名入力", "")
For i = 1 To UBound(v, 1)
v(i, 1) = s & v(i, 1)
Next
Rng.Value = v
End Sub
参考URL>>
http://officetanaka.net/excel/vba/speed/
（まっつわん） 2018/06/22(金) 21:12
>動かすと処理！次！処理！次！みたいな動きになりもっさりします。
そらそうでしょう。 毎回何行分か解らんけど、上書き繰り返しているし。
>For i = 8 To Cells(Rows.Count, 1).End(xlUp).Row > With rng > .Value = ans & .Value 'この行を修正 > End With >Next i （BJ） 2018/06/22(金) 22:53
seiyaさん、まっつわんさん、BJさんありがとうございます！
絶対処理もっとはやくなるよなぁ…と思いつつも
どうにもさわりきれない領域でしたので大変助かりました！
これにて本当に終わりとさせていただきます。
重ね重ね質問に回答いただきありがとうございました。
（ワニ） 2018/06/28(木) 14:31
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.