[[20220319075709]] 『連番が有るかの判断』(武藤) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『連番が有るかの判断』(武藤)

A2列からデーター(文字列)が下方向に入力されています。
先頭が連番の場合と連番がない場合があります。
(連番有り、連番無しのどちらかで混在することは無いです。)

例:連番有り(最初が01,001,1で始まる 3タイプ)で重複や欠番、タイプ別の混合は有りません。
01 aaaaa
02 bbbbb

001 aaaaa
002 bbbbb

1 aaaaa
2 bbbbb

例:連番無し
aaaaa
bbbbb

VBAでやりたいことは連番が有るかを判断したい。
例えば、FLAG=1なら連番有り、FLAG=0なら連番無しで求める等

連番タイプが3種類有るでコードが出来ていません。

< 使用 Excel:Office365、使用 OS:Windows10 >


 文字部分が5文字なのは一律なのですか?
(コナミ) 2022/03/19(土) 09:05

>文字部分が5文字なのは一律なのですか?

いいえ違います。
例は、aaaaaなどは見やすいように簡略化して表示しました。

実際の文字列は、可変で長さは一律では有りませんが3文字以下の極端に少数なことはありません。

テストでA2セルが、1,01,001の場合は連番が開始されると判断して
以下のようにコードを書いてみましたが
もっとスマートなマクロコードが無いでしょうか?

Sub test()
Dim i As Integer
Dim n1 As String, n2 As String, n3 As String
Dim flg As Integer

    n1 = Val(Left(Cells(2, 1), 1))
    n2 = Val(Left(Cells(2, 1), 2))
    n3 = Val(Left(Cells(2, 1), 3))

    If (n1 = 1 Or n2 = 1 Or n3 = 1) Then
        MsgBox "OK"
        flg = 1
    Else
        MsgBox "No"
        flg = 0
    End If

(武藤) 2022/03/19(土) 09:19


それだったら、
IsNumeric(Left(Cells(2, 1).Value, 1))
で良いのでは。
(烏) 2022/03/19(土) 09:32

>IsNumeric(Left(Cells(2, 1).Value, 1))

判断としては、以下のようになると思いますが違っていますか ?
簡単な判断ができそうです。

Sub test2()
Dim flg As Integer

If IsNumeric(Left(Cells(2, 1), 1)) = -1 Then

    MsgBox "Yes"
    flg = 1
Else
    MsgBox "OK"
    flg = 0
End Sub
(武藤) 2022/03/19(土) 09:57

ご自身で内容を把握されており、希望の動きをするのなら、
どのようなコードでも間違いではないと思います。
ですので、参考程度に。

 Sub test3()
    Dim flg As Boolean
    If IsNumeric(Left(Cells(2, 1), 1)) Then
        MsgBox "連番あり"
        flg = True
    Else
        MsgBox "連番なし"
        flg = False
    End If
 End Sub

(烏) 2022/03/19(土) 10:15


鳥さん、よくよく考えると
IsNumeric(Left(Cells(2, 1), 1))は、左から1文字目が「0」又は「1」の決め打ちなので
連番の可能性が無い0aaaaaaや1aaaaaも連番の最初だと判断されてしまいます。

やはり、2,02,002になるはずの2行目も見ないと
結局連番であるかは判断できそうにないです。
(武藤) 2022/03/19(土) 10:41


当初ご提示の例であれば、
IsNumericでの判定で良かったわけです。

提示例の様に連番後に半角スペースが必ず存在しているのなら、
半角スペースまでの文字列に対してIsNumeric関数で数値かどうかの判定は出来ます。

>やはり、2,02,002になるはずの2行目も見ないと
その思考ですと、エンドレスになりますね。
1aaa
2bbb
ccc
の時、連番と判断しませんよね。

二度手間を回避するために、連番なしのケースで起こりうる条件を提示されるのが良いと思います。

(烏) 2022/03/19(土) 11:02


>IsNumeric(Left(Cells(2, 1), 1))は、左から1文字目が「0」又は「1」の決め打ちなので
ここはちょっと勘違いされているようです。
IsNumeric関数は、文字列が数値として認識できるかどうかの判定をしているので、0 or 1 に限定したものではありません。
(烏) 2022/03/19(土) 11:12

 >IsNumeric関数は、文字列が数値として
                           数字

 IsNumeric("123456")  ???

(数値と数字) 2022/03/19(土) 11:24


>(数値と数字)さん

>IsNumeric("123456") ???
Trueが返りますね。
https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/isnumeric-function
もう少し具体的に説明していただいてもよろしいですか?

(烏) 2022/03/19(土) 11:32


考え違いが合ったようです。

私は、IsNumeric(Left(Cells(2, 1), 1))を

	セル文字列の左から1文字目が数値かどうかの判定すると思ったのですが
鳥さんは、
	セル文字の左から半角スペースまでの文字列に対して数値かどうか判定するとの回答ですか?

Left(Cells(2, 1), 1は、左から1文字抜き出すだから

 IsNumericを付ける事で
どこから「セル文字の左から半角スペースまで」の意味になるのか判りません。

連番が有る場合、
連番相当とその後に文字列の間に半角スペースが有る場合がほとんどですが
稀に無い場合もあります。

但し、以下のようになる事は有りません。
>1aaa
>2bbb
>ccc

連番なしと連番有りの混合は無く 3ccc と必ず連番になります。
又、連番無しと連番有りの混合は無いので以下なども有りえません。

1aaa
2bbb
ccc
3ddd

1aaa
2bbb
ccc
4ddd

’-----------------------------------------

2列目も判断に加えて
以下が現在の私が絞り出した煩雑なコードです。

Sub test()

Dim n11 As String, n12 As String, n13 As String
Dim n21 As String, n22 As String, n23 As String
Dim flg As Integer

    n11 = Val(Left(Cells(2, 1), 1))
    n12 = Val(Left(Cells(2, 1), 2))
    n13 = Val(Left(Cells(2, 1), 3))

    n21 = Val(Left(Cells(3, 1), 1))
    n22 = Val(Left(Cells(3, 1), 2))
    n23 = Val(Left(Cells(3, 1), 3))

    If (n11 = 1 Or n12 = 1 Or n13 = 1) And (n21 = 2 Or n22 = 2 Or n23 = 2) Then
        MsgBox "OK"
        flg = 1
    Else
        MsgBox "No"
        flg = 0
    End If

End Sub

(武藤) 2022/03/19(土) 11:34


因みに文字の抜きだしは文字。

MsgBox VarType(Left(12345, 3))

2 整数型
3 長整数型
4 単精度浮動小数点数型
5 倍精度浮動小数点数型
6 通貨型
7 日付型
8 文字列型

(数値と数字) 2022/03/19(土) 11:40


リンク先は、MSが間抜けなだけ。
(数値と数字) 2022/03/19(土) 11:42

ついでに

A1〜A5まで、文字として数字を書いて
A6にSUM(A1:A5)と書いて計算されますか?

更に
msgbox IsNumeric(range("A1").value)
(数値と数字) 2022/03/19(土) 11:51


完全な数値判定は、エクセル関数の isnumber をつかった方法しか私は知りません。
今回は、数値判定が必要なわけでもないのでIsNumericでも良いと思います。(全角数字の判定も必要なさそうなので)
(数値と数字) 2022/03/19(土) 11:58

>私は、IsNumeric(Left(Cells(2, 1), 1))を
>セル文字列の左から1文字目が数値かどうかの判定すると思ったのですが
その認識であっています。
「左から1文字目が「0」又は「1」の決め打ちなので」と書いていらしたので、0又は1に決め打ちしているわけではないということを伝えたかったわけです。

>どこから「セル文字の左から半角スペースまで」の意味になるのか判りません。
言葉足らずでした。
例えば、以下の様に半角スペースまでの文字列に対して、
IsNumeric関数で判定できるというつもりでした。

 Sub sample()
    Dim buf As Long
    With Cells(2, 1)
        buf = InStr(.Value, " ")
        If buf > 0 Then
            Debug.Print IsNumeric(Left(.Value, buf - 1))
        End If
    End With
 End Sub

>(数値と数字)さん
大変参考になりました。
「IsNumeric関数は、文字列が整数型の変数に格納できるかどうか判定している」という事で良いでしょうか。
ご指導ありがとうございました。

(烏) 2022/03/19(土) 12:09


 (数値と数字)さん

 >リンク先は、MSが間抜けなだけ。

 ちょっと意味が分からないので、何がどう間抜けなのか教えていただけませんか?
 私は単なる仕様の問題でしかないと思っているんですが。

(半平太) 2022/03/19(土) 12:12


エクセルの計算には、文字と数値がはっきりと分別されていると思ってます。
それを簡単に数値と表現する事がまぬけと思ってます。

>私は単なる仕様の問題でしかないと思っているんですが。

そう思っているのなら、ご自分で解説したらいいのでは。
(数値と数字) 2022/03/19(土) 12:23


 >「IsNumeric関数は、文字列が整数型の変数に格納できるかどうか判定している」
 そう思っていてほぼ間違いないです。

 文字列が数値として評価可能かどうかを判定するもので、
 ASCIIのアラビア数字であるかどうかを判断しているものではありません。

 以下のような数値表現の文字列もすべて True です。 

  Debug.Print IsNumeric("1.0E+03")  ' 単精度浮動小数点数
  Debug.Print IsNumeric("1.5D-02")  ' 倍精度浮動小数点数
  Debug.Print IsNumeric("&HFF")   ' 16進数文字列
  Debug.Print IsNumeric("&O11")     '  8進数文字列 

 全角数字も数値として評価可能(CLngとかの変換関数で変換可能)なので、Trueを返します。
 IsNumericはそういう関数です。    
(´・ω・`) 2022/03/19(土) 12:36

 >それを簡単に数値と表現する事がまぬけと思ってます。

 MSの解説は以下ですよ。

 >式を数値として評価できるかどうかを示すブール型 (Boolean) の値を返します。
 >
 >構文
 >IsNumeric(式)
 >
 >必要な 式の引数は、数値式または文字列式を 含む バリアント型 (Variant) です。

 数値かどうか判定をするなんて書いてないです。

(半平太) 2022/03/19(土) 12:50


私の意図していない質問内容とは少し離れた議論が続きましたが

その後、鳥さんのコードを参考にコードを改変中です。

配列が連番であるか?チェックするのに以下の関数をを利用したいと思います。

以下の関数では、連番候補がA1から下のセルに連続して配置されている事を想定しています。
(関数では、連番が途切れたセル番号を表示)

=WorksheetFunction.MATCH(0,WorksheetFunction.FREQUENCY(A1:A1000,ROW(A1:A1000)),0)
(A1:A1000は仮範囲で可変)

上記関数では、A列をチェック対象にしていますが
実際は、下記のマクロコード中の配列=Num()を対象にしたい。

連番であればNum()の最大値より大きな数値が返ってくるのでFlg=1
連番で無ければNum()最大値より小さな数値が返ってくるのでFlg=0

上記の関数を反映したコードにするにはどうしたら良いですか ?

’--------------------------

それと、イミディエイトウィンドウのクリアしたいのでネットの情報で以下を入れたのですが

    'Debug.Print String(200, vbCrLf)

確かにイミディエイトウィンドウは、クリアされますが
イミディエイトウィンドウの使用エリアだけがクリアーされて
次の書き出しが途中からとなるので上部に大きな空白エリアが出来てしまします。

多分、EXCELのバージョンによって仕様が違う為と思われますが
他のクリアーの方法をアドバイス下さい。

’--------------------------

Option Explicit

Sub test()

    Dim buf As Long
    Dim ln As Integer, i As Integer, ii As Integer
    Dim Num() As Variant, DifNum() As Variant
    Dim SumDif As Integer, TSumDif As Long

    ln = Cells(Rows.Count, 1).End(xlUp).Row

    ReDim Num(ln - 1)
    ReDim DifNum(ln - 2)

    'イミディエイトウィンドウのクリア
    'Debug.Print String(200, vbCrLf)

    For i = 2 To ln
        With Cells(i, 1)
            buf = InStr(.Value, " ")
            If buf > 0 Then
                Num(i - 2) = Val(Left(.Value, buf - 1))
                'Debug.Print Num(i - 2)
            End If
        End With
    Next

End Sub

(武藤) 2022/03/20(日) 07:52


 Sub test()
  Dim a() As String
  ReDim a(1 To 10)

  ' これは連番
  For i = 1 To 10: a(i) = i * 2: Next
  Debug.Print isSerialNumber(a), Join(a)

  ' これは連番じゃない
  For i = 1 To 10: a(i) = i ^ 2: Next
  Debug.Print isSerialNumber(a), Join(a)

  ' A列をテスト
  ReDim a(2 To Cells(Rows.Count, 1).End(xlUp).Row)
  For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
      a(i) = Split(Cells(i, 1), " ")(0)
  Next
  Debug.Print isSerialNumber(a), Join(a)

 End Sub

 Function isSerialNumber(n As Variant) As Boolean
  If Not IsArray(n) Then Exit Function
  If UBound(n) - LBound(n) = 1 Then isSerialNumber = True: Exit Function
  For i = LBound(n) + 1 To UBound(n) - 2
      If n(i + 2) - n(i + 1) <> n(i + 1) - n(i) Then Exit Function
  Next
  isSerialNumber = True
 End Function
(´・ω・`) 2022/03/20(日) 08:33

functionコードありがとうございます。

早速、テストDATAで試してみました。

以下のようにTrueのハズがFalseになります。
どこが変ですか?


(武藤) 2022/03/20(日) 11:44


 lnの値は6です。
 bufの宣言は buf(5) <= buf(0) 〜 buf(5) です。
 bufに値を入れた結果
 buf(0)= 1
 buf(2)= 2
 buf(3)= 3
 buf(4)= 4
 buf(5)= Empty

 関数isSerialNumberは配列の要素の値がすべて同じ差になってないとFalseです。

 コードを画像で見せられても、こっちは面倒なだけです。やめてください。

 以下蛇足です。
 個人的には、flgって変数名使うのは嫌いです。変数名をHeisuuとするのと同じくらいキラい
 bufってbufferの短縮だと思います。buffer的な使い方をしてない変数にbufって名前つかうのもキラい
 私の個人的な好き嫌いなので、気にしなくてもいいですが、
 変数の名前は実態を表す名前にしたほうが可読性がちょっとだけ向上します。
(´・ω・`) 2022/03/20(日) 12:18

>コードを画像で見せられても、こっちは面倒なだけです。やめてください。

御面倒な画像で失礼しました。
コードは画像で添付しないことに事にします。

解説を受けましたがイマイチ納得が出来ていません。

>bufの宣言は buf(5) <= buf(0) 〜 buf(5) です。
bufは、dim宣言で「Long」なので配列では有りませんが?
今回の場合配列扱いに成るのでしょうか?
(個人的には、ターゲット文字列の半角スペースの見つかった位置(数値)を一時的に記憶する変数
つまり、行毎に数値が置き換わるだけで配列のように記憶される必要はない変数と思っています。)

Num(i - 2) = Val(Left(.Value, buf - 1))で
ターゲット文字列の半角スペースより前の文字列を求めて、Valで数値に変更
lnが6だから、FOR分でiは、2,3,4,5,6と5回ループされる。

i=2 の場合 Num(i-2) ---> Num(0) は、1
i=3 Num(i-2) ---> Num(1) は、2
i=4 Num(i-2) ---> Num(2) は、3
i=5 Num(i-2) ---> Num(3) は、4
i=6 Num(i-2) ---> Num(4) は、5

利用しているNum()は0-4の5個なので
この5個をisSerialNumberで利用すると考えてもですが間違っていますか?

(武藤) 2022/03/20(日) 13:33


興味深く拝見してますが、いまいち議論のポイントがわかりません。
既にコメントがあるように、想定されるパターンを提示されたほうが話がスムーズかとおもいます。

なお、その際に画像への直リンクはやめたほうがよろしいかとおもいます。
(記事自体はずっとのこりますが、画像へのリンクが切れたときに、後から見て意味が分からなくなってしまいます)

例えば↓のようなら、皆さん仰るように1文字目が数字(数値)として評価できるかどうかだけで判定が可能ではないでしょうか?

     ____A_____   ____B___ 
  1    データ     判定結果
  2  1 aaa aaa    連番あり
  3  2 bbbb       連番あり
  4  3 c c cc     連番あり
  5  4 aaa_aa     連番あり
  6  5 c_c sss    連番あり
  7  6xxxxxx      連番あり
  8  7set         連番あり
  9  aac          連番なし
 10  a4a          連番なし

さらに「連番無しと連番有りの混合は無い」ということは↑のような状況でもなさそうですし、極端な話データ群の1番目(上記でいえばA2セル)だけ判定すればよいということだったりしませんか?

(もこな2) 2022/03/20(日) 13:54


 ごめんなさい bufじゃなくてnum 
 num(0)= 1
 num(1)= 2
 num(2)= 3
 num(3)= 4
 num(4)= 5
 num(5)= Empty
 >利用しているNum()は0-4の5個なので
 num(5)は値を代入してないだけで、Variant型の初期値であるEmptyが入ってます
 isSerialNumber は Ubound
 ステップ実行して確かめればわかるでしょう
 自分の使い易いように改良はお好きにどうぞ
(´・ω・`) 2022/03/20(日) 14:04

 ちょっと中途半端な文章が。
 isSerialNumber は Uboundで次元の上限まで値をみているので
(´・ω・`) 2022/03/20(日) 14:06

もこな2さんのご指摘を受けて

>想定されるパターンを提示されたほうが話がスムーズかとおもいます。

質問の最初に記載しましたが

連番有り(最初が01,001,1で始まる 3タイプ)で重複や欠番、タイプ別の混合は有りません。
途中で、半角スペース無しも候補に上がり話が見えなくなりましたが
実DATAは、連番の後ろに半角スペースが有る場合がほとんどですが稀に無い場合も有る。
(但し、検討するコードは、半角スペース有りだけで限定して回答願えれば十分です。)

半角スペースの後は文字列(文字長は可変)が存在。

以上が想定されるパターンです。

´・ω・`さん、ようやく説明を受けて理解できました。

ReDim Num(ln - 1)でln=6なのでNum(5)ですが、Num(0) ----- Num(5) の6個が確保される。
で確保されたNum(5)が使用されずにEmptyでisSerialNumber は Uboundで次元の上限まで値まで
検討するのでTrueのハズがFalseに成る。

>自分の使い易いように改良はお好きにどうぞ

なので、ReDim Num(ln - 2)とすれば「0」問題も解決する。

Option Base 1 を宣言すれば、「0」問題も無くなりますが
今は、宣言なしの Option Base 0 を基本にしたいと思っています。
(武藤) 2022/03/20(日) 14:48


>連番有り(最初が01,001,1で始まる 3タイプ)で重複や欠番、タイプ別の混合は有りません
いや…例示してみてはどうかって話だったんですが…

>検討するコードは、半角スペース有りだけで限定して回答願えれば十分です
それならA2セルの値をsplit関数で区切って最初の要素を【文字列】として見たときに、01,001,1,それ以外のどれなのか判定するとよいでしょう

(もこな2 ) 2022/03/20(日) 15:15


もこな2 さん、失礼しました。

「欠番は有りません」と書きましたが無いはず?です。
しかし人間のやることなので無いとは言えないので連番の整合性(1,2,3,-----)を含めてのコードを作成したいのです。

連番の最初の有無は、確かに「01,001,1,それ以外のどれなのか判定する」事で
可能でそれだけなら初心者の私にも出来ます。

すでに´・ω・`さんのアドバイスで連番の整合性を含めてのコードは出来ましたが、
せっかくなので先に質問した以下の件に付きアドバイスいただければ嬉しいです。

=WorksheetFunction.MATCH(0,WorksheetFunction.FREQUENCY(A1:A1000,ROW(A1:A1000)),0)

元ネタの投稿先は下記です。

MATCH(0,FREQUENCY(A1:A1000,ROW(A1:A1000)),0)
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1039451980

(武藤) 2022/03/20(日) 15:41


 >=WorksheetFunction.MATCH(0,WorksheetFunction.FREQUENCY(A1:A1000,ROW(A1:A1000)),0)
 元ネタはワークシート関数ですね
 VBAでやるために、MACTH関数とFREQUENCY関数は、
 WorksheetFunction.MATCH とかするとこまでは思いついたらしいらしいですが、
 ROW関数はどうするつもりでしたか?
 なので、こうするんだけど... 
 1 2 3 4 4 5 6 7 8 9 の場合もTrueになりますがいいですか?これで 

 Sub test()
  Dim a()
  ReDim a(1 To 10)
  For i = 1 To 10: a(i) = i: Next
  Debug.Print isSerial1(a), Join(a)
  For i = 5 To 10: a(i) = i - 1: Next
  Debug.Print isSerial1(a), Join(a)
  For i = 1 To 10: a(i) = i + 1: Next
  Debug.Print isSerial1(a), Join(a)
  ' A列をテスト
  ReDim a(2 To Cells(Rows.Count, 1).End(xlUp).Row)
  For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
      a(i) = Val(Split(Cells(i, 1), " ")(0))
  Next
  Debug.Print isSerial1(a), Join(a)
 End Sub

 Function isSerial1(a) As Boolean
    'mina = WorksheetFunction.Min(a)
    mina = 1
    maxa = WorksheetFunction.Max(a)
    n = Evaluate("=Row(A" & mina & ":A" & maxa & ")")
    With WorksheetFunction
       ret = .Match(0, .Frequency(a, n), 0)
    End With
    isSerial1 = ret > maxa
 End Function
(´・ω・`) 2022/03/20(日) 16:32

 こうすれば、『1から始まる増分1の連番』のときだけTrueかな?
 Function isSerial1(a) As Boolean
    m = UBound(a) - LBound(a) + 1
    n = Evaluate("=Row(A1:A" & m & ")")
    With WorksheetFunction
       ret = .Match(0, .Frequency(a, n), 0)
    End With
    isSerial1 = ret > m
 End Function
(´・ω・`) 2022/03/20(日) 17:40

´・ω・`さん、検証ありがとうございます。

確かに
MATCH(0,FREQUENCY(A1:A1000,ROW(A1:A1000)),0)は、

1 2 3 4 4 5 6 7 8 9 の場合もTrueになりました。
結果、この関数は連番をチェックする場合は適当では無い事が判りました。

ROW関数はどうするつもりでしたか?

マクロの素人なのでMatchやFrequency関数もWorksheetFunction.を頭に付けることで
VBAでも使用できる事がある程度ネット検索で判明していたので
ROW関数も同じかなと思いましたがネット検索でヒットしませんでした。

検索が悪いだけでVBA賢者さんは代替え案が有ると踏んで質問しましたが
16:32の「isSerial1(a)」ファンクションではFalseで使用できないと
一度は観念しましたが
17:40の「isSerial1(a)」ファンクションでは旨く判断できるマクロを作成いただきました。

全く無駄な努力を押し付ける提案なのに対処いただき感謝いたします。

(武藤) 2022/03/20(日) 18:45


 全ては読んでいないのですが、
 このケースって大丈夫だったんですか?
  ↓
 0 2 3 4

(半平太) 2022/03/20(日) 19:10


 番号が等差級数でないといけないという条件ならダメですね
 飽きてきた...
(´・ω・`) 2022/03/20(日) 19:43

半平太さんの上げた「0から始まる」ケースは無いので考えないことにしています。

>番号が等差級数でないといけないという条件ならダメですね

等差級数と言うのですね。
勉強になります。

私の考えていた順番は、「等差級数」で前後の差が「1」が理想ですが
それ以外の数値でもOKです。

´・ω・`さんの17:40のコードで
実際、番号が等差級数でない「1 2 3 4 6 7 8 10 11」のケース試してみましたがFalseと表示されました。
(同じく 「1 2 4 6 7 8 9 11 12」のケースもFalse)

但し、「1 3 5 7 9 11 13 15」の前後の差が2の場合も等差級数ですがFalseとなりました。

一案ですが、番号が等差級数なら
「 1 2 3 4 5 6 7 」なら最初と最後の数を足して、内側に収縮するような感じで計算した数が全て等しくなると思います。

 つまり、 1+7,2+6,3+5 は全て8です。

「1 3 5 7 9 11 13 15」の前後の差が2の場合は、SUMは16で全て同じなので等差級数。

「1 2 3 4 6 7 8 10 11 13」なら
1+13=14,2+11=13,4+8=12,6+7=13 で等しくないで番号が等差級数でない。

「VBA 等差級数」 で検索するとヒットするので少し調べてみます。

(武藤) 2022/03/21(月) 06:22


 | Option Base 1 を宣言すれば、「0」問題も無くなりますが
 | 今は、宣言なしの Option Base 0 を基本にしたいと思っています。

 Option Base 0 であっても
 ・Dim ary(1 To 10)
 ・10の部分が可変であれば、
   n = 10 
   Redim ary(1 To n)
 のように書けば、indexを1から始めることができます。

 既に適切なFunctionプロシージャが示されているところですが、
 質問者さんご自身が判定するコードを一度書かれたらどうですか?
 それが一番身に付きますし、今後の対応もご自身でできるようになると思います。

 できるだけプリミティブな形にしておくことです。
  c = ary(2) - ary(1) を求め、
  For k = 3 to n
      ary(k) - ary(k-1) が c と一致するかどうかを調べ、
      不一致であれば、メッセージを出して、 Exit For 
  Next 
 のようなものです。 
 ループを使うなら、最初と最後を足してとかするより、基本的なものにしておいたほうがよいと思います。

 余談ですが、それは【等差数列】と呼ぶほうが普通だと思います。
 等差級数は等差数列の和で表されるものを言うと思います。
 1,2,3,4,5 ....
 は
 1,1,1,1,1 .. という階差(公差ですか)0 の等差数列の和と考えれば、
 それは等差級数であるとも言えますが、
 1,2,3,4,5 ....は等差数列と呼ぶほうが普通だと思います。
 (慣用的に等差数列のことを等差級数と呼ぶことがあるかもしれませんが、
   等差数列と呼んで間違いと言われることはないと思います。)

(γ) 2022/03/21(月) 07:43


 単にダメなパターンをはじくことで対処
  Function isSerial1(a) As Boolean
    If Not IsArray(a) Then Exit Function    '追加
    If a(LBound(a)) <> 1 Then Exit Function '追加
    m = UBound(a) - LBound(a) + 1
    n = Evaluate("=Row(A1:A" & m & ")")
    With WorksheetFunction
       ret = .Match(0, .Frequency(a, n), 0)
    End With
    isSerial1 = ret > m
 End Function

 γさん
 おっしゃるとおり級数ではなくて数列ですね 
(´・ω・`) 2022/03/21(月) 08:20

>余談ですが、それは【等差数列】と呼ぶほうが普通だと思います。

γさん、アドバイスありがとうございます。

	配列でOption Base 0 でもindexを1から始める方法を学びました。

>できるだけプリミティブな形にしておくことです。

	アドバイスを受けて手順をトレースするマクロを考えてみます。

>「VBA 等差級数」 で検索するとヒットするので少し調べてみます。

「VBA 等差級数」、改【等差数列】でネット情報で
理想の公差=1の場合で考えてみました。

Sub test_3()

    Dim ln As Long, N As Long
    Dim SumN As Long, SumC As Long

    ln = Cells(Rows.Count, 1).End(xlUp).Row
    N = ln - 1  'n 番目の項

    '等差数列の各項の総和 (公差が1の場合)
        SumN = N * (N + 1) / 2
        'MsgBox "SumN = " & SumN

    '各セルの合計
        SumC = Application.WorksheetFunction.Sum(Range(Cells(2, 1), Cells(ln, 1)))
        'MsgBox "SumC = " & SumC

    If SumN = SumC Then
        flg = 1  '等差数列
    Else
        flg = 0  '等差数列では無い
End Sub

(武藤) 2022/03/21(月) 08:51


 Sub test_3()は
 1
 0
 0
 9
 の場合もflg=1になりますが、いいですか?
(´・ω・`) 2022/03/21(月) 09:05

test_3は、全然プリミティブではないと思いますよ。
既にご指摘があるとおりかと思います。

元数列の階差をしらべて、それがすべて最初の項の階差と一致することが等差数列の定義です。

そのことが保証されていれば、
途中で数値がスキップしたり、重なることがないことが保証されるんですよ。
だからFrequencyも不要になりますね。
階差がいくつであろうとロジック変更は不要です。

そういったことがプリミティブと言ったことの意味です。

(γ) 2022/03/21(月) 09:28


>Sub test_3()は
>1
>0
>0
> 9
>の場合もflg=1になりますが、いいですか?

最初の番号が、「0」から始まることが無いと述べましたが
途中の番号が「0」になる事も有りません。
そのため、´・ω・`さんの取り上げた特異例は考慮する必要は無いと思います。

>test_3は、全然プリミティブではないと思いますよ。

すいません、言葉が足りませんでした。

 Sub test_3()がγさんが解説されていたプリミティブである例として上げたのではありません。
【等差数列】でネット情報をしらべてのコードの案として例です。

先の書き込みで
以下の 1),2)のように分けたのは1)と2)は別の回答だと言う意味です。

	1)>できるだけプリミティブな形にしておくことです。
		アドバイスを受けて手順をトレースするマクロを考えてみます。

	2)>「VBA 等差級数」 で検索するとヒットするので少し調べてみます。

(まだ、

 「アドバイスを受けて手順をトレースするマクロを考えてみます。」と書いたようにコードはまだ出来ていません。)

(武藤) 2022/03/21(月) 10:33


 >そのため、´・ω・`さんの取り上げた特異例は考慮する必要は無いと思います。
 もう何がしたいのかわからないので、私はこの辺で退散します。

 ちなみに、4つの数字の場合で、
 1+1+2+5=10
 1+1+4+4=10
 と和が10になるパターンはいくらでもあります。
 数字が増えればもっと増えます。
 和だけで判断するのは無理でしょうという趣旨の話をしています。
(´・ω・`) 2022/03/21(月) 10:49

>和だけで判断するのは無理でしょうという趣旨の話をしています。

´・ω・`さんとγさんの回答を受けて
等差数列の公差(N)を比較するマクロ(γさんの提案)を作成してみました。
どうでしょうか ?

Option Explicit

Sub test_5()

    Dim buf As Long
    Dim ln As Integer, i As Integer, ii As Integer
    Dim Num As Variant
    Dim N As Integer
    Dim flg As Boolean

    ln = Cells(Rows.Count, 1).End(xlUp).Row - 1

    ReDim Num(1 To ln)

    For i = 2 To ln + 1
        With Cells(i, 1)
            buf = InStr(.Value, " ")  'ターゲットの半角スペースの見つかった位置(数値)
            If buf > 0 Then
                Num(i - 1) = Val(Left(.Value, buf - 1))  'ターゲットの半角スペースより前の文字
            End If
        End With
    Next

    N = Num(2) - Num(1)

    For ii = 3 To ln
        If Num(ii) - Num(ii - 1) = N Then
            flg = 1
        Else
            flg = 0
            Exit For
        End If
    Next

    Debug.Print flg, Join(Num)

End Sub
(武藤) 2022/03/21(月) 11:02


詳細は拝見していませんが、
ご自分で機能を満たしていると判断されているのであれば、
それで良いのではないでしょうか。

数値が頭についていない場合への対応とか、
どこで等差にならなくなったかを示す必要はないか、
等々、必要であれば追々と追加していけばよいと思います。

すでに過去のどこかの時点で機能は満たされていたように思いますが、
ご自分でコードを書くことによってできることが広がっていく感覚が大事かと思います。

横合いから失礼しました。

(γ) 2022/03/21(月) 14:02


γさん、ざっと見た感じは概ね合格点を頂いたと判断して
これから実際のコードに追加していきます。

お付き合い願いありがとうございます。

	数値が頭についていない場合への対応は、既に完成済みです。
	どこで等差にならなくなった場合は、一度数値部を削除して改めて
	頭に数値が入るように変更する予定です。

	改良を始めると初心者なのに「あれやこれや」がで追加事項が出てくるので塩梅が難しいです。

(武藤) 2022/03/21(月) 15:45


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.