[[20211211144501]]　『特定文字を抜き出す』（キリン）　ページの最後に飛ぶ

『特定文字を抜き出す』（キリン）

お世話になっております。
品名から、特定の文字を抜き出し、隣のセルに記載するマクロを作成したいと思っています。
ご教示いただきたく、宜しくお願い致します。

抜き出したい文字は、下記の通りです。
ﾘﾝｺﾞ
ｻｸﾗﾝﾎﾞ
ﾓﾓ
ﾅｼ
ﾌﾞﾄﾞｳ
ｶｷ

シート名（Sheet1）
１行目はタイトルです。
A１＝品名
B１＝抜き出したい文字

２行目以降がデータです。
A２＝1111(ﾘﾝｺﾞ)
A３＝ﾔﾏｶﾞﾀｻｸﾗﾝﾎﾞ
A４＝A555ﾐｶﾝ
A５＝ｻｸﾗﾝﾎﾞ000ｼﾝｼﾞｭｸ
続きます。

B２＝ﾘﾝｺﾞ
B３＝ｻｸﾗﾝﾎﾞ
B４＝（空白セル）
B５＝ｻｸﾗﾝﾎﾞ

※ﾓﾓのように、今回は品名に出てこないケースもあります。
※B4のように、対象外の品名は、記載なし（空白セル）のままにしておきたいです。

Sub moji()
Dim i As Long
With Worksheets("Sheet1")
For i = 2 To .Cells(.Rows.Count,"A").End(xlUp).Row

Next
End With
End Sub

ご教示いただきたく、宜しくお願い致します。

＜使用 Excel：unknown、使用 OS：unknown ＞

⬆️のマクロ動きますか？
エラーになりませんか？
（通りすがり） 2021/12/11(土) 15:05

まずは、リンゴだけについて考えてみてはどうでしょうか。
それができたら、他の品名についても同様に繰り返せばよいです。

（マナ） 2021/12/11(土) 16:30

数式でもよいなら、

例えば、↓とか参考になりませんか。
[[20130706184926]]　『表にある文字列を抽出して表示する』

（マナ） 2021/12/11(土) 17:03

通りすがり様
はい。エラーになります。

マナ様
ご返信有難うございます。
過去の参考リンク有難うございます。
すみません。マクロで作成したいと考えています。

おっしゃる通り、リンゴだけで考えてみました。
りんごだけ、A1セルA2セルだけで作成してみましたが、
思うように起動しません。
なぜか、A1のセルが削除され、A2にもﾘﾝｺﾞが転機されません。
すみませんが、ご教示いただけますと助かります。
宜しくお願い致します。

Sub moji()
Dim i As String
Dim x As Worksheet
Dim a As Integer

Set x = Worksheets("Sheet1")
i = ﾘﾝｺﾞ
a = InStr(x.Range("A1").Value, i)

If a > 0 Then
x.Range("A2") = i
Else
x.Range("A2") = ""
End If

End Sub
（キリン） 2021/12/11(土) 18:36

 こんな感じかな。
 注：半角カタカナでアップすると文字化けするので、全角にしてあります。
 　　そちらで、半角に戻してください。

 Sub moji()
    Dim i As Long
    Dim ary
    Dim rDST As Range
    Dim vDST

    ary = Array("リンゴ", "サクランボ", "モモ", "ナシ", "ブドウ", "カキ")

    With Worksheets("Sheet1")
        Set rDST = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).Offset(, 1)
        vDST = rDST.Value

        For i = 1 To rDST.Rows.Count
            vDST(i, 1) = Application.Lookup(999, Application.Find(ary, rDST(i, 1).Offset(, -1)), ary)

            If IsError(vDST(i, 1)) Then
                vDST(i, 1) = Empty
            End If
        Next

        rDST.Value = vDST
    End With
 End Sub

（半平太） 2021/12/11(土) 18:39

半平太様
ご回答いただき、有難うございます。
サンプルの表では起動できました。
実際の表は位置が少々異なり、エラーにはならないのですが、結果が反映されませんでした。
実際の表は、J列が品名にあたり、
抜き出し先の列は、BI列になります。
Lookupについて、調べてみたのですが、よくわからなかったので教えてください。
vDST(i, 1) = Application.Lookup(999, Application.Find(ary, rDST(i, 1).Offset(, -1)), ary)
999は、何を意味するのでしょうか？

お手数おかけしますが、よろしくお願い致します。
（キリン） 2021/12/12(日) 00:53

 >実際の表は、J列が品名にあたり、抜き出し先の列は、BI列になります。

 参考に
 Sub test()
    Dim c As Range
    Dim x As Worksheet
    Dim ary As Variant
    Dim a As Variant

    Set x = Worksheets("Sheet1")
    ary = Array("リンゴ", "サクランボ", "モモ", "ナシ", "ブドウ", "カキ") '←半角で記述の事
    For Each c In x.Range("J2", x.Cells(Rows.Count, "J").End(xlUp))
        For Each a In ary
            If InStr(c, a) > 0 Then
                x.Cells(c.Row, "BI").Value = a
            End If
        Next
    Next
 End Sub

（ピンク） 2021/12/12(日) 09:48

 Sub moji()
     Dim i As Long
     Dim ary
     Dim V

     ary = Array("リンゴ", "サクランボ", "モモ", "ナシ", "ブドウ", "カキ")

     With Worksheets("Sheet1")
         V = .Range("J2", .Cells(.Rows.Count, "J").End(xlUp)).Value

         For i = 1 To UBound(V)
             V(i, 1) = Application.Lookup(999, Application.Find(ary, V(i, 1)), ary)

             If IsError(V(i, 1)) Then
                 V(i, 1) = Empty
             End If
         Next

         .Range("BI2").Resize(UBound(V), 1).Value = V
     End With
 End Sub

 ＞999は、何を意味するのでしょうか？

 Lookup関数の検索値です。各文字列データの長さより大きければ何でもいいです。 
 Find関数の戻り値が、合致位置の配列を返してくるので、その一番右にある数値の位置を探るもの。

（半平太） 2021/12/12(日) 10:05

ピンク様　半平太様
お世話になっております。
ご回答いただき、有難うございます。
無事に起動できました。本当に有難うございました。
（キリン） 2021/12/12(日) 14:21

コメント返信：

[ 一覧(最新更新順) ]

[[20211211144501]] 『特定文字を抜き出す』（キリン） ページの最後に飛ぶ

[[20211211144501]]　『特定文字を抜き出す』（キリン）　ページの最後に飛ぶ