Option Explicit
Public Sub 不要物削除()
    Dim i As Long
    Dim RE As Object
    Dim str As String
    Dim matches As Object
    Dim submatch As Object
    Set RE = CreateObject("VBScript.RegExp")
    RE.Pattern = "^(\d+-\d+).*$"
    RE.Global = True
    For i = 1 To 4000
        str = Cells(i, "B").Value
        If str <> "" Then
            Set matches = RE.Execute(str)
            If matches.Count > 0 Then
                Set submatch = matches.Item(0).submatches
                Cells(i, "A").Value = submatch(0)
            End If
        End If
    Next
End Sub
 
 

T3B0aW9uIEV4cGxpY2l0ClB1YmxpYyBTdWIg5LiN6KaB54mp5YmK6ZmkKCkKICAgIERpbSBpIEFzIExvbmcKICAgIERpbSBSRSBBcyBPYmplY3QKICAgIERpbSBzdHIgQXMgU3RyaW5nCiAgICBEaW0gbWF0Y2hlcyBBcyBPYmplY3QKICAgIERpbSBzdWJtYXRjaCBBcyBPYmplY3QKICAgIFNldCBSRSA9IENyZWF0ZU9iamVjdCgiVkJTY3JpcHQuUmVnRXhwIikKICAgIFJFLlBhdHRlcm4gPSAiXihcZCstXGQrKS4qJCIKICAgIFJFLkdsb2JhbCA9IFRydWUKICAgIEZvciBpID0gMSBUbyA0MDAwCiAgICAgICAgc3RyID0gQ2VsbHMoaSwgIkIiKS5WYWx1ZQogICAgICAgIElmIHN0ciA8PiAiIiBUaGVuCiAgICAgICAgICAgIFNldCBtYXRjaGVzID0gUkUuRXhlY3V0ZShzdHIpCiAgICAgICAgICAgIElmIG1hdGNoZXMuQ291bnQgPiAwIFRoZW4KICAgICAgICAgICAgICAgIFNldCBzdWJtYXRjaCA9IG1hdGNoZXMuSXRlbSgwKS5zdWJtYXRjaGVzCiAgICAgICAgICAgICAgICBDZWxscyhpLCAiQSIpLlZhbHVlID0gc3VibWF0Y2goMCkKICAgICAgICAgICAgRW5kIElmCiAgICAgICAgRW5kIElmCiAgICBOZXh0CkVuZCBTdWIKCg==