エクセルのマクロで"～"を用いた数字の連番

質問

エクセルのマクロで"～"を用いた数字の連番
について、ちょっと困っています。

以下のように、セルに入力があります。

A1：0
A2：1
A3：2
A4：3
A5：4
A6：5
A7：6
A8：7
A9：8
A10：9
A11：10

次に、B1～B11の任意のセルに "無" もしくは "有" の文字を入力し、
B列に"有"の文字が入力されているA列の数字を"～"を用いて連番にしたい。
ただし、「0」は独立した値とし、「B1：有、B2：有」の場合、「0～1」ではなく、
「0,1」とカンマ区切りとする。

（例）

A1：0／B1：有
A2：1／B2：有
A3：2／B3：無
A4：3／B4：有
A5：4／B5：有
A6：5／B6：有
A7：6／B7：無
A8：7／B8：無
A9：8／B9：有
A10：9／B10：無
A11：10／B11：無

⇒ 『 A12 = 0,1,3～5,8 』としたい。

マクロでご教授いただけると幸いです。
よろしくお願いいたします。

回答No.10

Wendy02 · ベストアンサー

#5,#7の回答者です。

>また実際に作成しているものは（例）とは少し異なっております。
>「行」は２行目以降でも応用できたのですが、「列」がうまくいきません。
>どの部分を変えればよいのか、ご教授いただけると幸いです。

異なっているなら、異なっている部分を書かないと分からないのです。もう少し、回答者の読んでいる側のことをもう少し考えてください。隣り合った列ではないなら、ないと書いてください。

それに、少なくとも、私は、ご質問者さんにコードの内容を理解してもらうつもりで書いていませんし、定数値以外の編集を望んでいません。そんなことをしていたら、私たち含めて永遠に、プログラムなど分かることはありません。

#5の現在のコードは、隣り合った列のものに対してのみ有効になっています。だから、離れた場所にある場合は、引数を二つにしなければなりません。

第1列が、A20:A30, 第2列が、E20:E30

=Linkage(A20:A30,E20:E30)

なお、範囲がシートが別々でも可能です。
'//
Public Function Linkage(rng1 As Range, rng2 As Range)
'各々の2列を選択
Dim Ar As Variant
Dim i As Long, j As Long
Dim buf As String
Dim flg As Integer
ReDim Ar(rng1.Rows.Count - 1)
Ar = Application.Transpose(rng1.Columns(1))
For i = LBound(Ar) To UBound(Ar)
　If rng2.Cells(i, 1).Value Like "無*" Then
　　Ar(i) = Empty
　End If
Next
For j = LBound(Ar) To UBound(Ar) - 1
　If Not IsEmpty(Ar(j)) And buf = "" Then
　　buf = Ar(j)
　　If CStr(Ar(j)) = "0" Then
　　　flg = -1
　　End If
　ElseIf flg = -1 And buf <> "" And Not IsEmpty(Ar(j)) Then
　　buf = buf & "," & Ar(j)
　　flg = 0
　ElseIf Not IsEmpty(Ar(j)) And IsEmpty(Ar(j + 1)) Then
　　If flg > 1 Then
　　　buf = buf & "～" & Ar(j)
　　Else
　　　buf = buf & "," & Ar(j)
　　End If
　　flg = 0
　ElseIf Not IsEmpty(Ar(j)) Then
　　If flg = 0 Then
　　　buf = buf & "," & Ar(j)
　　End If
　End If
　If Not IsEmpty(Ar(j)) And Not IsEmpty(Ar(j + 1)) Then
　　flg = flg + 1
　End If
Next
If UBound(Ar) = j And Not IsEmpty(Ar(j)) Then
　If flg < 2 Then
　　buf = buf & "," & Ar(j)
　ElseIf flg > 1 Then
　　buf = buf & "～" & Ar(j)
　End If
End If
Linkage = buf
End Function

'マクロに取り付けるなら、このようになります。
Sub Test1r()
　　Range("A12").Value = Linkage(Range("A20:A30"),Range("E20:E30"))
End Sub

回答No.11

layy

質問例回答例と実際のセル位置や値が違うのは想定の範囲です。ロジック、考え方さえ間違えなければ解決に向かうと思います。そのまま稼動するような完全なるものは機密公開になりかねないので制限あります。だれもが閲覧する場ですし。

２列目Ｂ列の「有」「無」文字を判断している箇所を追跡して下さい。初期値から変わってないまま、？行目２列目Ｂ列を意味しているはずです。
５列目が実際の列としたら２＋３列と流動化せても何か出来そうです。

回答No.9

imogasi

色々なやりかたがあると思うし、この手の問題は複雑になり勝ち。下記も結構複雑ですが他と比べてどうでしょうか。
例データ
Ａ１：Ａ２１に
有
有
無
有
無
有
無
有
無
無
有
無
無
有
無
有
無
有
有
無
有
ーー
コード
Sub test01()
'--第１行のみ特別扱い
If Cells(1, "A") = "有" Then
f = "0,"
Else
f = ""
End If
'--第2行以降を「有」だけを配列に入れる
Dim s(100)
j = 1 '1からスタート
d = Range("A65536").End(xlUp).Row '最下行を取得
MsgBox d
For i = 2 To d
If Cells(i, "A") = "有" Then
s(j) = i - 1
j = j + 1
End If
Next i
dsuu = j - 1 '有の数を保存
MsgBox dsuu
'---その配列ｓについて
t = "" '文字列初期化、クリア。
'--1,2番目は必ずセットする特別扱い
t = t & s(1) & "," & s(2) & ","
'--２番目以降
ren = 0 '初期状態では連なりなしでスタート
For j = 3 To dsuu
If s(j) = s(j - 1) + 1 Then '整数的に連続なら＝直前と同じなら
'--tの最後の「,」を「～」に変える
Mid(t, Len(t), 1) = "～"
ren = ren + 1 '連の数を1増やす
Else
'--不連続なら
Select Case ren
'--renの数＝0なら
Case ren = 0
'--自分＋「,」を入れる
t = t & s(j) & ","
'--renの数＝1なら
Case ren = 1
'--自分＋「,」を入れる
t = t & s(j) & ","
Case Else
'--renの数>＝2なら,終わり数に直前を加え、スタートに自分＋「,」を入れる
t = t & s(j - 1) & "," & s(j) & ","
End Select
ren = 0 'renを初期状態に
End If
Next j
'--後じまい
Select Case ren
Case 0
t = Left(t, Len(t) - 1) ''を除く
Case 1
t = t & s(dsuu) '最後の数を追加
Case Is >= 2
t = t & s(dsuu) '最後の数を追加
End Select
'--セルにセット
Cells(23, "Ｅ") = f & t
End Sub
ーーーーー
結果
C23に
0,1,3,5,7,10,13,15,17～18,20
Ａ列の「有」の連なりを色々変えてテストしてみてください。

回答No.8

layy

＞可能性あり
こういう記載、回答者さんお願いしますね、という意味だったら丸投げです。

動作が怪しい点、確認しておかないといけない点は
（対応をどっちがやるかは別として）
今の段階で明確にしなければなりません。

特に、説明漏れがあって、
今までの回答があまり使えなくて再検討になるようなことあれば
それはあとになって、質問者自身で修正できるようにがんばるしかないのです。
そうならないためにも、
質問投稿して待っている状態かもしれませんが、
質問者自身においても今の段階でいろいろ習得し考えて欲しいです。
「この処理は何？」「こんな仕組みでできるんだ」「このケースでも大丈夫だな」
「こんなのは大丈夫だろうか」等考えてもらいたいので投稿しました。

最終的な動作確認は回答者でなくて質問者です。
支援者はいっぱいいます。がんばりましょう。

>・２連続の場合　→　","
>・３連続以上の場合　→　"～"
対応箇所がわからなければズバリ説明をもらって
質問者にて修正・確認できれば、と思います。
そういう（自分で考えて修正をする）やり方が上達しやすいです。

回答No.7

Wendy02

#5の回答者です。

>・２連続の場合　→　","
>・３連続以上の場合　→　"～"
これは、すでに出来ているはずです。

一応、元の質問内容に対して、私の書いた内容は、想定済みだと思いましたが、何か問題でもあるのですか？こちらの作った、ユーザー定義関数を標準モジュールに貼り付けて、A12に、数式を貼りつければ済むと思いますし、マクロにも付けられます。しかし、そのままにされると、何かとても気持ち悪いですね。

それと、#6さんへの補足の内容は、最初の質問要件が変わってくるし、それが、どういう結果になるか書いていただかないと、こちらとしては、見当が付きません。すべて0だったら、0だけにするのか、言い換えると、数字にダブりがある場合は、編成しなおして、ユニーク番号だけ出していくのか、「可能性あり」という意味は、「解答できる可能性はあり」という回答にしかなりません。任意の数字で、順不同で数列になっていなかったり、ダブりや飛び番がある場合など、可能性があるものに対して、具体的な例を示し、望む戻り値を示していただかないと、現実には不可能です。本来、質問要件が、最初の内容と変わって引き伸ばされると、解答に至るのは極めて難しくなっていきます。

なお、基本的には、常識的な数値範囲(Integer型の範囲-整数に限る）で使われるものとして作ればよいとしています。

私のユーザー定義関数の結果
***
(1)　「有」がないケース
　　 "" ←見えない

(2)　「０」だけのケースで、「有」だけの場合
　　　0,0～0

(3)　「１」だけのケースで、「有」だけの場合
　　　1～1

(4)　「１０」だけのケースで、「有」だけの場合
　　　10～10

(5)　「全部有」のケースで、0～10まである
　　　0,1～10

#4の補足に対しては、
　　0,1,3,4,7～9

とすでになっています。ですから、質問の原則は外していないはずです。

お礼

Wendy02様

私もマクロ等にあまり慣れておらず、また実際に作成しているものは（例）とは少し異なっております。
他の方も含め、ご回答いただいたコードを解析して、応用するのに手間取っており、お礼が遅くなってしまいました。
申し訳ございませんでした。

私が不慣れなせいもあり、どうしても応用できない部分があります。

ご回答のコードは行/列共に１行/列目から始まっていますが、実際は行も列も１行/列目ではありません。
「行」は２行目以降でも応用できたのですが、「列」がうまくいきません。
どの部分を変えればよいのか、ご教授いただけると幸いです。

よろしくお願いします。

回答No.6

layy

補足）

念のため、
下記のようにいろんなケースを提示し、確認しておいてください。

「有」がないケース、
「０」だけのケース、
「１」だけのケース、
「１１」だけのケース、
「全部有」のケース、等。

１１までありますが、
範囲が変わって０～９までになったときのケースを想定し、
これもどこをどう変えたらよいのか、変えなくても良いのか等。

補足

補足、ありがとうございます。

(1)　「有」がないケース
　→　Ｂ列が「有」のときのＡ列の数字のみ表示
　　（Ｂ列に「無」が入力されない空欄「""」の場合もあり・・・「無」or「""」）

(2)　「０」だけのケース
　　→　可能性あり

(3)　「１」だけのケース
　　→　可能性あり

(4)　「１０」だけのケース
　　→　可能性あり

(5)　「全部有」のケース
　　→　可能性あり

(6)　Ａ列の数字の範囲
　　→　「０」～「１０」です（「１０」を超えることはありません）

よろしくお願いいたします。

回答No.5

Wendy02

同じような質問が最近ありましたので、隣り合った数字、例えば、1と2　の場合は、～　でつなげず、「,」で区切るというリクエストがありましたので、同じようにしました。

例：
　0,1,2,4～10　←隣り合う数字だけの場合は、1～2 とはならず、1,2 になります。

それが、違うようでしたら、ご指摘ください。一部を変えるだけです。
また、最初の0のない場合も想定しました。

A12 に以下のように置いてください。
=Linkage(A1:B11)

'//標準モジュール
Public Function Linkage(rng As Range)
'2列を選択
Dim Ar As Variant
Dim i As Long, j As Long
Dim buf As String
Dim flg As Integer
ReDim Ar(rng.Rows.Count - 1)
Ar = Application.Transpose(rng.Columns(1))
For i = LBound(Ar) To UBound(Ar)
　If rng.Cells(i, 2).Value Like "無*" Then
　　Ar(i) = Empty
　End If
Next
For j = LBound(Ar) To UBound(Ar) - 1
　If Not IsEmpty(Ar(j)) And buf = "" Then
　　buf = Ar(j)
　　If CStr(Ar(j)) = "0" Then
　　　flg = -1
　　End If
　ElseIf flg = -1 And buf <> "" And Not IsEmpty(Ar(j)) Then
　　buf = buf & "," & Ar(j)
　　flg = 0
　ElseIf Not IsEmpty(Ar(j)) And IsEmpty(Ar(j + 1)) Then
　　If flg > 1 Then
　　　buf = buf & "～" & Ar(j)
　　Else
　　　buf = buf & "," & Ar(j)
　　End If
　　flg = 0
　ElseIf Not IsEmpty(Ar(j)) Then
　　If flg = 0 Then
　　　buf = buf & "," & Ar(j)
　　End If
　End If
　If Not IsEmpty(Ar(j)) And Not IsEmpty(Ar(j + 1)) Then
　　flg = flg + 1
　End If
Next
If UBound(Ar) = j And Not IsEmpty(Ar(j)) Then
　If flg < 2 Then　'* ～の付ける条件
　　buf = buf & "," & Ar(j)
　ElseIf flg > 1 Then
　　buf = buf & "～" & Ar(j)
　End If
End If
Linkage = buf
End Function

'マクロに取り付けるなら、このようになります。
Sub Test1()
　　Range("A12").Value = Linkage(Range("A1:B11")) '範囲を入れる
End Sub

回答No.4

nattocurry

Sub test()
Dim r As Long, rHead As Long, rTail As Long
If Cells(1, "B").Value = "有" Then Cells(12, "A").Value = Cells(1, "A").Value
For r = 2 To 12
If Cells(r, "B").Value = "有" Then
If rHead = 0 Then
rHead = Cells(r, "A").Value
Else
rTail = Cells(r, "A").Value
End If
Else
If rHead > 0 Then
If rTail > 0 Then
With Cells(12, "A")
.Value = .Value & "," & rHead & "～" & rTail
End With
Else
With Cells(12, "A")
.Value = .Value & "," & rHead
End With
End If
rHead = 0
rTail = 0
End If
End If
Next r
End Sub

補足

ご回答ありがとうございます。

希望の結果が得られました。

ちなみにですが、数字が
・２連続の場合　→　","
・３連続以上の場合　→　"～"
で接続したい場合は、どのようなコードになるのでしょうか？

（例）
A1：0／B1：有
A2：1／B2：有
A3：2／B3：無
A4：3／B4：有
A5：4／B5：有
A6：5／B6：無
A7：6／B7：無
A8：7／B8：有
A9：8／B9：有
A10：9／B10：有
A11：10／B11：無
⇒ 『 A12 = 0,1,3,4,7～9 』としたい。

お願いばかりで恐縮です。
よろしくお願いいたします。

回答No.3

TNK787

Sub test()
Dim i As Long
Dim atai As Variant

For i = 1 To 11
If Cells(i, 2).Value = "有" Then
If atai = "" Then
atai = Cells(i, 1).Value
Else
If atai = 0 Then
atai = atai & "," & Cells(i, 1).Value
Else
atai = atai & "～" & Cells(i, 1).Value
End If
End If
End If
Next
Cells(12, 1).Value = atai

End Sub

回答No.2

TNK787

？？？
～って単に記載を省略しただけではないのですか？

ちょっと意味がわかりません

回答No.1

TNK787

Sub test()
Dim i As Long
Dim atai As String

For i = 1 To 11
If Cells(i, 2).Value = "有" Then
If atai = "" Then
atai = Cells(i, 1).Value
Else
atai = atai & "," & Cells(i, 1).Value
End If
End If
Next
Cells(12, 1).Value = atai

End Sub

お礼

早速回答いただき、ありがとうございます。

早速試してみましたが（例）の結果だと、
「0,1,3,4,5,8」
となってしまいます。

0と1以外は"～"を使った連番にしたいので、
「0,1,3～5,8」
となって欲しいです。

また、よろしくお願いいたします。