Excel VBA質問箱 IV

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

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


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

6191 / 76807

←次へ　｜　前へ→


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

Yuki - 14/10/17(金) 11:12 -


	引用なし

	パスワード

▼シェバルブランさん：
>
>説明不足で申し訳ありません。実はこんな感じです。

こんにちは。
こんな感じでしょうｊか

>シリアル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

2 hits

▼

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