太郎 スニーカー、S) 中村 ベスト、Mサイズ) 木下 靴下、L) 田中 カバン) 太郎 M、靴) 福田 机) 大宮 テレビ、L) ↓ ↓ ↓

画像

Visual Basic | Excel32閲覧xmlns="http://www.w3.org/2000/svg">500

ベストアンサー

0
画像

ThanksImg質問者からのお礼コメント

皆様ご回答ありがとうございます。 おかげさまで無事コード作成出来ました。 ありがとうございました。 ベストアンサーには 詳しくご回答下さりました**sk様とさせて頂きます。 宜しくお願い致します。

お礼日時:6/18 17:02

その他の回答(2件)

0

2列目に記載されている場合以下でどうでしょうか? Sub test() For i = 1 To Cells(Rows.Count, 2).End(xlUp).Row     Cells(i, 2).Value = IsSize(Cells(i, 2).Value) Next i End Sub Function IsSize(mytxt As String)     Dim arr(2)     arr(0) = "S"     arr(1) = "M"     arr(2) = "L"     For i = 0 To 2     If InStr(Split(mytxt, " ")(1), arr(i)) > 0 Then         IsSize = Split(mytxt, " ")(0) & arr(i)         Exit Function     End If     Next i     IsSize = Split(mytxt, " ")(0) End Function

0

もっといい方法が あるかもしれませんが 下記では いかがですか? Columns("A:A").Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True Columns("B:B").Select Selection.Replace What:="*S*", Replacement:="S", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Selection.Replace What:="*M*", Replacement:="M", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Selection.Replace What:="*L*", Replacement:="L", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False For i = 1 To Cells(Rows.Count, "B").End(xlUp).Row If Cells(i, "B") <> "S" And Cells(i, "B") <> "M" And Cells(i, "B") <> "L" Then Cells(i, "B").ClearContents End If Next

画像