|
▼Yuki さん:
本当にありがとうございます。
できましたが、これにはいくつかのパターンがありまして、
A1でないところにある場合は以下で出来そうです。
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("I1").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(16).Resize(, 2).ClearContents
.Range("P1").Resize(, 2).Value = .Range("I1").Resize(, 2).Value
.Range("P2").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
Err.Clear ' 追加行
End If
End If
Next
If i > Len(v) Then Exit Function
strRevers = CLng(StrReverse(Left(v, i - 1)))
End Function
項目名(シリアルN0、データ)が、1行目でない場合や
シリアルNo、とデータが離れている場合はどこを操作すればいいのでしょうか?
すみませんがよろしくお願いします。
|
|