文字操作 シート上のテキストから特定文字群を抽出

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub TxtSarch()
'
Dim strTarget As String
Dim x As Long
Dim y As Long
Dim z As Integer
Dim i As Integer
Dim j As Long
Dim k As Byte
Dim sht As Worksheet
Dim shtOut As Worksheet
Dim strFind As String
Dim strFind2 As String
Dim strOutTXT As String

Set sht = Workbooks("Test.xls").Worksheets("Sheet1") '**SET**
Set shtOut = Workbooks("Test.xls").Worksheets("Sheet2") '**SET**

strFind = "zip" '**SET**
strFind2 = "http:" '**SET**

k = Len(strFind)
x = sht.Range("a65536").End(xlUp).Row

For y = 1 To x
    strTarget = sht.Range("a" & y).Value
    i = InStr(strTarget, strFind)
        If i <> 0 Then
            z = InStr(strTarget, strFind2)
                If z <> 0 Then
                    strOutTXT = Mid(strTarget, z, i - z + k)
                    j = shtOut.Range("a1").CurrentRegion.Rows.Count + 1
                    shtOut.Range("a" & j).Value = strOutTXT
                End If
        End If
Next y

Set sht = Nothing
Set shtOut = Nothing

End Sub

 

 

 

2000年01月01日|[VBサンプルコード]:[文字操作]