| |
こんなかな？
Option Explicit
Public Sub Extraction()
Dim i As Long
Dim vntResult As Variant
With ActiveSheet
For i = 2 To .Cells(65536, "A").End(xlUp).Row
vntResult = UnitPrice(.Cells(i, "A").Value)
.Cells(i, "B").Resize(, UBound(vntResult)).Value = vntResult
Next i
End With
End Sub
Private Function UnitPrice(ByVal vntLine As Variant) As Variant
Dim i As Long
Dim vntData() As Variant
Dim lngPos As Long
Dim lngRead As Long
Dim vntTmp As Variant
Dim lngLineLen As Long
vntLine = Trim(vntLine)
lngLineLen = Len(vntLine)
lngRead = 1
i = 0
ReDim vntData(1 To 1)
Do Until lngRead > lngLineLen
lngPos = InStr(lngRead, vntLine, " ", vbTextCompare)
If lngPos = 0 Then
vntTmp = Mid(vntLine, lngRead)
lngRead = lngLineLen + 1
Else
vntTmp = Mid(vntLine, lngRead, lngPos - lngRead)
lngRead = lngPos + 1
End If
If IsNumeric(vntTmp) Then
i = i + 1
ReDim Preserve vntData(1 To i)
vntData(i) = vntTmp
End If
Loop
UnitPrice = vntData
End Function
|
|
Hirofumi
- 04/12/9(木) 21:15 -
