Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

6187 / 76807

←次へ　｜　前へ→


	【76222】Re:番号を並べて表記したいのです。

シェバルブラン

- 14/10/17(金) 13:48 -


	引用なし

	パスワード

▼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、データ）が、１行目でない場合や
シリアルNo、とデータが離れている場合はどこを操作すればいいのでしょうか？
すみませんがよろしくお願いします。

2 hits

▼

【76209】番号を並べて表記したいのです。 シェバルブラン 14/10/16(木) 9:34