Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


8734 / 13644 ツリー ←次へ | 前へ→

【31487】セル内文字列(指定文字)の分割 超初心者SS 05/11/22(火) 22:08 質問[未読]
【31488】Re:セル内文字列(指定文字)の分割 ponpon 05/11/22(火) 22:59 発言[未読]
【31489】Re:セル内文字列(指定文字)の分割 ichinose 05/11/22(火) 23:16 発言[未読]
【31491】Re:セル内文字列(指定文字)の分割 超初心者SS 05/11/23(水) 7:29 お礼[未読]

【31487】セル内文字列(指定文字)の分割
質問  超初心者SS  - 05/11/22(火) 22:08 -

引用なし
パスワード
   困っています。
抽出したいデータ(ランダムに)がA列に入っており、その中から指定した文字(2種類=本数,本)を分割しB列に抽出したいのですが・・教えてください宜しくお願いします。

   A
1
2 ***本数
3  **
4  **本
5 *** 

<結果>
   A  B
1
2 ***  本数
3  **
4  **  本
5 ***   

【31488】Re:セル内文字列(指定文字)の分割
発言  ponpon  - 05/11/22(火) 22:59 -

引用なし
パスワード
   こんばんは。
作ってみました。

Sub test()
  Dim myR As Range, r As Range
  Dim Acnt As Integer
  
  Set myR = Range("A2", Range("A65536").End(xlUp))
  For Each r In myR
     Acnt = InStr(r.Value, "本")
    If Acnt > 0 Then
     r.Offset(0, 1).Value = Mid$(r.Value, Acnt, Len(r.Value) - Acnt + 1)
     r.Value = Left$(r.Value, Len(r.Value) - (Len(r.Value) - Acnt + 1))
    End If
  Next
  set myR = Nothing
End Sub

【31489】Re:セル内文字列(指定文字)の分割
発言  ichinose  - 05/11/22(火) 23:16 -

引用なし
パスワード
   ▼ponpon さん、超初心者SSさん、こんばんは。

検索したい文字列が二つは、必ず、一部が含まれている
(本---本数、品---品数、証---証拠のように)のであれば、
ponpon さんの方法がよさそうですね。

以下のコードはA列のデータをB列とC列に分割し、
最終的にA列を削除するコードです。

'======================================================
Sub main()
  Dim 検索1 As String
  Dim 検索2 As String
  検索1 = "本"
  検索2 = "本数"
  wk = 検索1
  If Len(検索1) < Len(検索2) Then
    検索1 = 検索2
    検索2 = wk
    End If
  Dim rng As Range
  Set rng = Range("a2", Cells(Rows.Count, 1).End(xlUp))
  With rng
    If .Row > 1 Then
     With .Offset(0, 1).Resize(, 2)
       .Formula = _
        Array("=IF(ISERROR(FIND(""" & 検索1 _
            & """,A2)),SUBSTITUTE(A2,""" & 検索2 & _
            """,""""),SUBSTITUTE(A2,""" & _
            検索1 & """,""""))", _
            "=IF(ISERROR(FIND(""" & 検索1 & _
            """,A2)),IF(A2=B2,"""",""" & 検索2 _
            & """),""" & 検索1 & """)")
       'B列には、
       ' =IF(ISERROR(FIND("本数",A2)),SUBSTITUTE(A2,"本",""),SUBSTITUTE(A2,"本数",""))
       'C列には
       '=IF(ISERROR(FIND("本数",A2)),IF(A2=B2,"","本"),"本数")
       'この例では、上記のような数式が入る
       .Value = .Value
       End With
     Range("a:a").Delete
     End If
    End With
End Sub

確認してください。

【31491】Re:セル内文字列(指定文字)の分割
お礼  超初心者SS  - 05/11/23(水) 7:29 -

引用なし
パスワード
   ponpon さん、ichinoseさん

おはようございます。
お返事遅くなりすみませんでした。
お二人には大変感謝しております。
本当にありがとうございます!*(*^-^*)*

また何かありましたら教えてください。

8734 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free