Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1119 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【76209】番号を並べて表記したいのです。 シェバルブラン 14/10/16(木) 9:34 質問[未読]
【76210】Re:番号を並べて表記したいのです。 kanabun 14/10/16(木) 12:36 質問[未読]
【76211】Re:番号を並べて表記したいのです。 Yuki 14/10/16(木) 12:50 発言[未読]
【76214】Re:番号を並べて表記したいのです。 シェバルブラン 14/10/16(木) 13:47 お礼[未読]
【76215】Re:番号を並べて表記したいのです。 Yuki 14/10/16(木) 16:07 発言[未読]
【76217】Re:番号を並べて表記したいのです。 シェバルブラン 14/10/17(金) 8:29 発言[未読]
【76218】Re:番号を並べて表記したいのです。 Yuki 14/10/17(金) 11:12 発言[未読]
【76220】Re:番号を並べて表記したいのです。 Yuki 14/10/17(金) 11:18 発言[未読]
【76222】Re:番号を並べて表記したいのです。 シェバルブラン 14/10/17(金) 13:48 お礼[未読]
【76224】Re:番号を並べて表記したいのです。 Yuki 14/10/17(金) 16:37 発言[未読]
【76242】Re:番号を並べて表記したいのです。 シェバルブラン 14/10/20(月) 8:32 お礼[未読]
【76212】Re:番号を並べて表記したいのです。 kanabun 14/10/16(木) 12:50 発言[未読]
【76213】Re:番号を並べて表記したいのです。 シェバルブラン 14/10/16(木) 13:04 お礼[未読]
【76209】番号を並べて表記したいのです。
質問  シェバルブラン E-MAIL  - 14/10/16(木) 9:34 -
引用なし
パスワード
   初めて投稿させてもらいます。
なやんでいたら、このサイトを見つけ、おもわず投稿させてもらいました。
やりたいことは、以下ののような番号の表示をすべての番号が一つずつに
なるように表示したいのです。
番号
A143
A144
A145
A146〜A147
A149
A153
A156〜A159
A160
A161〜A163
A165

これを以下のように、
番号
A143
A144
A145
A146
A147
A149
A153
A156
A157
A158
A159
A160
A161
A162
A163
A165

このように、VBAで行うにはどすれば良いのでしょうか？
よろしくお願いします。
【76210】Re:番号を並べて表記したいのです。
質問  kanabun  - 14/10/16(木) 12:36 -
引用なし
パスワード
   ▼シェバルブラン さん：

質問です。

>番号
>A143
>A144
>A145
>A146〜A147
>A149
>A153
>A156〜A159
>A160
>A161〜A163
>A165
>
この元のデータはどこにあるのですか？

>これを以下のように、
>番号
>A143
>A144
>A145
>A146
>A147
>A149
>A153
>A156
>A157
>A158
>A159
>A160
>A161
>A162
>A163
>A165
>
>このように、VBAで行う
同じく どこに出力しようとしていますか？
【76211】Re:番号を並べて表記したいのです。
発言  Yuki  - 14/10/16(木) 12:50 -
引用なし
パスワード
   ▼シェバルブラン さん：

A 列　　又　出力はＤ列とします。適宜変更して下さい。
>番号
>A143
>A144
>A145
>A146〜A147
>A149
>A153
>A156〜A159
>A160
>A161〜A163
>A165

Sub TESTa()
　　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
　　
　　With Worksheets("Sheet1").Range("A1").CurrentRegion
　　　　v = .Offset(1).Resize(.Rows.Count - 1).Value
　　End With
　　For i = 1 To UBound(v)
　　　　a = Split(v(i, 1), "〜")
　　　　If UBound(a) = 0 Then
　　　　　　ReDim Preserve d1(j)
　　　　　　d1(j) = v(i, 1)
　　　　　　j = j + 1
　　　　Else
　　　　　　n1 = StrReverse(Val(StrReverse(a(0))))
　　　　　　n2 = StrReverse(Val(StrReverse(a(1))))
　　　　　　k = j
　　　　　　For j = j To j + n2 - n1
　　　　　　　　ReDim Preserve d1(j)
　　　　　　　　d1(j) = Left(a(1), Len(a(1)) - Len(CStr(n2))) & n1
　　　　　　　　n1 = n1 + 1
　　　　　　Next
　　　　End If
　　Next

' 出力先　変更して
　　With Worksheets("Sheet1")
　　　　.Columns(4).ClearContents
　　　　.Range("D1").Value = .Range("A1").Value
　　　　.Range("D2").Resize(j).Value = Application.Transpose(d1)
　　End With
End Sub
【76212】Re:番号を並べて表記したいのです。
発言  kanabun  - 14/10/16(木) 12:50 -
引用なし
パスワード
   元データが A列に書いてあって、
C列に出力するものとすると、
一例ですが、以下とか？

'---------------------------------------------------- 標準モジュール
Option Explicit

Sub Try1()
　Dim c As Range　　'元データセル
　Dim r As Range　　'出力先セル
　Dim i As Long, j As Long, k As Long
　Dim ss As String, s As String
　Dim v As Variant
　Const z = "〜"
　
　　Set r = [C1]
　　For Each c In Range("A1", Cells(Rows.Count, 1).End(xlUp))
　　　　ss = c.Value
　　　　If InStr(ss, z) = 0 Then
　　　　　　k = k + 1
　　　　　　r(k, 1).Value = ss
　　　　Else
　　　　　　v = Split(ss, z)
　　　　　　s = Left$(v(0), 1)
　　　　　　For j = Val(Mid$(v(0), 2)) To Val(Mid$(v(1), 2))
　　　　　　　　k = k + 1
　　　　　　　　r(k, 1).Value = s & j
　　　　　　Next
　　　　End If
　　Next
　　
End Sub
【76213】Re:番号を並べて表記したいのです。
お礼  シェバルブラン E-MAIL  - 14/10/16(木) 13:04 -
引用なし
パスワード
   早速の回答、ありがとうございます。
助かりました。
【76214】Re:番号を並べて表記したいのです。
お礼  シェバルブラン E-MAIL  - 14/10/16(木) 13:47 -
引用なし
パスワード
   ▼Yuki さん：
大変ありがとうございます。
すいませんが、この番号の右横にデータがあって
「〜」のついている番号は同じデータになるようにできるでしょうか。
もし、お手間でなければこれも教えて頂けないでしょうか？
よろしくお願いします。
【76215】Re:番号を並べて表記したいのです。
発言  Yuki  - 14/10/16(木) 16:07 -
引用なし
パスワード
   ▼シェバルブラン さん：
>▼Yuki さん：
>大変ありがとうございます。
>すいませんが、この番号の右横にデータがあって
>「〜」のついている番号は同じデータになるようにできるでしょうか。
>もし、お手間でなければこれも教えて頂けないでしょうか？
>よろしくお願いします。
上記のデータはどのようになっているのでしょか。
右横にデータを言われてもｙｐ区分かりませんので
例をあげてデータ、結果を示して頂けないでしょうか
【76217】Re:番号を並べて表記したいのです。
発言  シェバルブラン E-MAIL  - 14/10/17(金) 8:29 -
引用なし
パスワード
   ▼Yuki さん：

説明不足で申し訳ありません。実はこんな感じです。

シリアル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
（以下省略）

これをシリアルNo.ごとのデータを付けています。
よろしくお願いします。
【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
【76220】Re:番号を並べて表記したいのです。
発言  Yuki  - 14/10/17(金) 11:18 -
引用なし
パスワード
   >▼シェバルブラン さん：
1行追加です。

>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
　　　　　　　　 Err.Clear　　　　　　　 ' 追加行　　　　　　　　　　　　　>　　　　　　　　Exit For
>　　　　　　End If
>　　　　End If
>　　Next
>　　If i > Len(v) Then Exit Function
>　　strRevers = CLng(StrReverse(Left(v, i - 1)))
>End Function
【76222】Re:番号を並べて表記したいのです。
お礼  シェバルブラン E-MAIL  - 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、とデータが離れている場合はどこを操作すればいいのでしょうか？
すみませんがよろしくお願いします。
【76224】Re:番号を並べて表記したいのです。
発言  Yuki  - 14/10/17(金) 16:37 -
引用なし
パスワード
   ▼シェバルブラン さん：


こんにちは。

　　　　　If Err.Number <> 0 Then
　　　　　　　　 Err.Clear　　　　　　　 ' 追加行
　　　　　　　　 Exit For
　　　　　　End If
　　　　End If
　　Next
　　If i > Len(v) Then Exit Function
　　strRevers = CLng(StrReverse(Left(v, i - 1)))

End Function

とりあえず上記の修正をお願いします。


>項目名（シリアルN0、データ）が、１行目でない場合や
>シリアルNo、とデータが離れている場合はどこを操作すればいいのでしょうか？
>すみませんがよろしくお願いします。
質問です。例えば　Deta が D 列と I 列の 6行目(タイトル行)から有った時

Ｅ列〜Ｈ列のデータはどうするのですか。
　D 列　　　　　　　　 E　　 F　 　G　　　H 列
LWG4815534　　　　　　 ここにDataが　　 TCLU4461414
LWG4815539〜LWG4815541 有った時　　　　 TCLU4461498
LWG4815542　　　　　　　　　　　　　　　HJCU4339945

　　　　　　　　　　　　　↓

LWG4815534　　　　　　　　　　　　　　　TCLU4461414
LWG4815539　　　　　　 此処の追加された TCLU4461498
LWG4815540　　　　　　 行の処理　　　　 TCLU4461498
LWG4815541　　　　　　　　　　　　　　　TCLU4461498
LWG4815542　　　　　　　　　　　　　　　HJCU4339945
【76242】Re:番号を並べて表記したいのです。
お礼  シェバルブラン E-MAIL  - 14/10/20(月) 8:32 -
引用なし
パスワード
   >▼Yuki さん：
ご指導、ありがとうございます。
シリアルNoやデータがどこにあっても、
Sheet2を作って、A1にシリアルNo、B1にデータをコピーすれば、
出来そうです。
これくらいならなんとかなります。
ありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1119 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free