|
▼シェバルブラン さん:
>
>説明不足で申し訳ありません。実はこんな感じです。
こんにちは。
こんな感じでしょうjか
>シリアルNo. データ
>LWG4815496 HJCU4339989
>LWG4815499 TCLU4461415
>LWG4815516 TCLU4461416
>LWG4815525 TCLU4461423
>LWG4815527 HJCU4339993
>LWG4815530 HJCU4339994
>LWG4815532 TCLU4461415
>LWG4815534 TCLU4461414
>LWG4815539〜LWG4815541 TCLU4461498
>LWG4815542 HJCU4339945
>LWG4815547 HJCU4339990
>LWG4815548 HJCU4339993
>LWG4815550〜LWG4815552 TCLU4461415
>LWG4815556 TCLU4461544
>LWG4815559〜LWG4815560 TCLU4461420
>LWG4815567 HJCU4339922
>LWG4815569 HJCU4339994
>LWG4815572 TCLU4461424
>LWG4815580 HJCU4339932
>(以下省略)
Sub TESTb()
Dim v As Variant
Dim i As Long
Dim j As Long
Dim k As Long
Dim d1() As Variant
Dim a As Variant
Dim n1 As Long
Dim n2 As Long
Dim act As Long
With Worksheets("Sheet2")
With .Range("A1").CurrentRegion
v = .Offset(1).Resize(.Rows.Count - 1).Value
End With
ReDim Preserve d1(1 To .Rows.Count - 1, 1 To 2)
End With
j = 1
For i = 1 To UBound(v)
a = Split(v(i, 1), "〜")
If UBound(a) = 0 Then
d1(j, 1) = v(i, 1)
d1(j, 2) = v(i, 2)
j = j + 1
Else
n1 = CLng(strRevers(a(0)))
n2 = CLng(strRevers(a(1)))
k = j
act = k + (n2 - n1)
For j = k To act
d1(j, 1) = Left(a(1), Len(a(1)) - Len(CStr(n2))) & n1
d1(j, 2) = v(i, 2)
n1 = n1 + 1
Next
End If
Next
With Worksheets("Sheet2")
.Columns(4).Resize(, 2).ClearContents
.Range("D1").Resize(, 2).Value = .Range("A1").Resize(, 2).Value
.Range("D2").Resize(j, 2).Value = d1
End With
End Sub
Function strRevers(expression As Variant) As Long
Dim v As Variant
Dim n1 As Variant
Dim i As Long
v = StrReverse(expression)
For i = 1 To Len(v)
On Error Resume Next
If Not Application.IsNumber(CLng(Mid(v, i, 1))) Then
If Err.Number <> 0 Then
Exit For
End If
End If
Next
If i > Len(v) Then Exit Function
strRevers = CLng(StrReverse(Left(v, i - 1)))
End Function
|
|