こんにちは。
ワークシートの関数でもできると思いますが、その場合は、一旦、メニューのデータの「区切り位置」で、空白で切り分けして、A列,B列に分けます。
E1:
=SUMPRODUCT(COUNTIF(A1,"*"&{"給料","払い","貸付金","賞与","保険"}&"*"))
F1:
=SUMPRODUCT(COUNTIF(B1,"*"&{"給料","払い","貸付金","賞与","保険"}&"*"))
G1:
=IF(E1=0,RIGHT(A1,2),IF(F1=0,RIGHT(B1,2),"その他"))
として、フィルをドラッグしてコピーすれば出来上がります。
{"給料","払い","貸付金","賞与","保険"}
のリストは、名前ではないと感知できるレベルの単語を並べてください。
そういう作業が面倒ならば、以下のような「ユーザー定義関数」が考えられます。
以下のリストも、ご自身で、名前ではないと感知できるレベルの単語を入れてください。
すべてでなくてよいです。
標準モジュールへの取り付け方:
Alt + F11 (Altを押しながらF11)を押すと、Visual Basic Editor 画面が出てきます。
次に、メニューの[挿入]-[標準モジュール]と開けて、クリックすると、画面が現れますので、以下のコードを貼り付けて、
Alt + Q で、画面を閉じます。
後は、
=PickupName(A1,2)
のように入れてあげれば、名前が出てきます。引数の2は、2文字ということです。
'-----------------------------------------------------------------
'Option Explicit
'ユーザー設定
Private Const LIST As String = "給料|払い|貸付金|賞与|保険"
Function PickupName(rng As Range, num As Integer)
Dim strText As String
Dim buf As String
Dim Matches As Object 'Matches
If IsEmpty(rng.Value) Then PickupName = "": Exit Function
strText = Replace$(Trim$(rng.Value), " ", " ", , , vbTextCompare)
With CreateObject("VBScript.RegExp")
.Pattern = "[^ ]*(" & LIST & ")[^ ]*"
.Global = False
If .Test(strText) = False Then PickupName = "その他": Exit Function
Set Matches = .Execute(strText)
buf = Matches(0)
buf = Replace$(strText, buf, "")
End With
If Len(buf) > 0 Then
PickupName = Right$(Trim$(buf), num)
Else
PickupName = ""
End If
End Function
お礼
このやり方で解決しました。 どうも、ありがとうございました。