[[20200930160811]]　『間の文字列を求めるプログラム』（よねこ）　ページの最後に飛ぶ

『間の文字列を求めるプログラム』（よねこ）

初めまして。

質問があります。

エクセルでQ4-Q8までの文字が1つのセルに入っているとします。
ここで、関数かVBAで
Q4-Q8の間のQ5.Q6.Q7を表示させるにはどうしたらいいですか？

お願いします。

＜使用 Excel：Excel2019、使用 OS：Windows7 ＞

 Replaceで「Q」を””に置換
 「-」でSplit

 Splitの0番目の要素と1番目の間を補完、でいかがでしょう？
（OK） 2020/09/30(水) 16:23

 VBAのサンプルです。
 必要に応じて
   For i = kai + 1 To shu - 1
 を
   For i = kai  To shu
 に変更してください。

 Sub test()
  Dim celstr As String
  Dim kugiri As String
  Dim kai As Integer
  Dim shu As Integer
  Dim newcelstr As String
  Dim i As Integer
   celstr = ActiveCell.Value
   celstr = Replace(celstr, "Q", "")
   sp = Split(celstr, "-")
   kai = sp(0) * 1
   shu = sp(1) * 1
   newcelstr = ""
   For i = kai + 1 To shu - 1
    If newcelstr <> "" Then newcelstr = newcelstr & ","
    newcelstr = newcelstr & "Q" & i
   Next i
   ActiveCell.Value = newcelstr
 End Sub
（OK） 2020/09/30(水) 16:34

ありがとうございます。
ちなみに一列の中に複数ある場合はどうしたら良いでしょうか？A2-A5など
複数の場合です。
すみませんがよろしくお願いします。
（よねこ） 2020/09/30(水) 16:41

 私の提示したものは、アクティブｾﾙが対象なので、セル範囲を
 ループ処理してはいかがでしょう？
（OK） 2020/09/30(水) 16:42

すみませんがその場合のプログラムを教えていただくと助かります。
お願いします。
（よねこ） 2020/09/30(水) 16:52

 ループ処理の参考HPです。

http://officetanaka.net/excel/vba/tips/tips111b.htm

 ↑はループ対象が
 Selection '選択セル
 ですが

 Selection
 の部分を

 Range("A1:A10")

 とするとA1～A10が対象になります。

 A1からA列の最終行まで、という
 指定もできます。そこはおいおい勉強して
 みてください。
（OK） 2020/09/30(水) 17:22

ありがとうございます。
ご丁寧にありがとうございます。
ご教授いただいたプログラムの一番最後に入れればよろしいでしょうか？
すみませんがお願いします。
出来たら書いてもらうと助かります。
（よねこ） 2020/09/30(水) 17:32

ループ処理は

 For Each c In Range("A1:A10")
  cに対する処理
 Next c

 のように記述します。

 コードの一番最後ループのみを記述しても全く
 意味がありません。

 ループの中に処理を記述します。
（OK） 2020/09/30(水) 17:40

 サンプルコードです。

 Sub test2()
  Dim rng As Range
  Dim c As Range
  Dim celstr As String
  Dim kugiri As String
  Dim kai As Integer
  Dim shu As Integer
  Dim newcelstr As String
  Dim i As Integer
   Set rng = ActiveSheet.Range("A2:A5")
   For Each c In rng
    celstr = c.Value
    celstr = Replace(celstr, "Q", "")
    sp = Split(celstr, "-")
    kai = sp(0) * 1
    shu = sp(1) * 1
    newcelstr = ""
    For i = kai + 1 To shu - 1
     If newcelstr <> "" Then newcelstr = newcelstr & ","
     newcelstr = newcelstr & "Q" & i
    Next i
    c.Value = newcelstr
    Erase sp
   Next c
   Set rng = Nothing
 End Sub
（OK） 2020/09/30(水) 17:44

ありがとうございます。
質問ですが、
Q", "")

    sp = Split(celstr, "-")
    kai = sp(0) * 1
    shu = sp(1) * 1
    newcelstr = ""
    For i = kai + 1 To shu - 1
     If newcelstr <> "" Then newcelstr = newcelstr & ","
     newcelstr = newcelstr & "Q" & i
    Next i
    c.Value = newcelstr
のQの部分を文字は指定しないで補完する事も可能でしょうか？
ご教授お願いします。
（よねこ） 2020/09/30(水) 17:53

LeftやMidで切出した文字を変数で指定してみてください。
（OK） 2020/09/30(水) 18:00

 無理やり関数！
 1-9までの数値のみ

    |[A]  |[B]                 
 [1]|Q4-Q8|Q5,Q6,Q7            
 [2]|A5-A7|A6                  
 [3]|B2-B9|B3,B4,B5,B6,B7,B8   
 [4]|C1-C9|C2,C3,C4,C5,C6,C7,C8
 B2=LEFT(A1)&SUBSTITUTE(TRIM(MID(SUBSTITUTE(SUBSTITUTE("1 2 3 4 5 6 7 8 9",MAX(IFERROR(FIND(MID(A1,ROW($1:$5),1),"123456789"),"")),REPT(" ",100)),MIN(IFERROR(FIND(MID(A1,ROW($1:$5),1),"123456789"),"")),REPT(" ",100)),100,100))," ",","&LEFT(A1))
 配列数式で確定
（稲葉） 2020/09/30(水) 18:10

ありがとうございます。
文字を指定しないで対象列でPC1-PC3やD9-D11,D14,D17がある場合のものを作成してみたのですが、
Private Sub CommandButton1_Click()
Dim rng As Range

  Dim c As Range
  Dim celstr As String
  Dim kugiri As String
  Dim kai As Integer
  Dim shu As Integer
  Dim newcelstr As String
  Dim i As Integer
   Set rng = ActiveSheet.Range("L1:L500")
   For Each c In rng
    celstr = c.Value
    celstr = Replace(celstr, "", "")
    sp = Split(celstr, "-")
    kai = sp(0) * 1
    shu = sp(1) * 1
    newcelstr = ""
    For i = kai + 1 To shu - 1
     If newcelstr <> "" Then newcelstr = newcelstr & ","
     newcelstr = newcelstr & "" & i
    Next i
    c.Value = newcelstr
    Erase sp
   Next c
   Set rng = Nothing

End Sub
実行すると型が一致しませんとでます。
どこがおかしいでしょうか？
ご教授お願いします。
（よねこ） 2020/09/30(水) 18:25

すみません
補足ですが、
列の中にはPC1-PC3やD9-D11,D14,D17の他にIC1など補完しなくても良いもの含まれています。
そういのも加味したVBAを教えていただけると助かります。

勝手なお願いばかりして大変恐縮ですがぜひお願いします。

失礼します。
（よねこ） 2020/09/30(水) 18:31

 >列の中にはPC1-PC3やD9-D11,D14,D17の他にIC1など補完しなくても良いもの含まれています。

 除外対象をDictionaryオブジェクトに格納しておいて、
 セルの文字列がDictionaryに含まれてなかったら処理、
 でいかがでしょう？

 >実行すると型が一致しませんとでます。

 コードのどの部分で出ますか？
（OK） 2020/09/30(水) 18:40

 >celstr = Replace(celstr, "", "")

 長さ0の文字列を長さ0の文字列に置換しています。
 つまり、何も変わっていません。
（OK） 2020/09/30(水) 18:41

kai = sp(0) * 1
の部分で出ます。

出来たらサンプルコードをお願いします。

大変恐縮ですがよろしくお願いします。
困っています。
（よねこ） 2020/09/30(水) 18:44

 急いでいるのなら、稲葉さんの配列数式で
 解決しませんか？

 試したらうまくいきましたけど。
（OK） 2020/09/30(水) 18:49

すみませんでした。
そういう意味で書いたつもりではないのです。

（よねこ） 2020/09/30(水) 18:56

  kai = sp(0) * 1

 これは
 sp(0)
 が数字になってないとエラーになります。

 前段階の

 celstr = Replace(celstr, "", "")

 で何も置換されてないので、
 celstrを区切り文字でSplitした
 一つ目の要素、つまりsp(0)に数字以外
 の文字列が含まれていると思われます。

（OK） 2020/09/30(水) 18:58

ありがとうございます。
エラー回避するには
kai = sp(0) * 1をどのように変換すればよろしいでしょうか？
他にも問題があるでしょうか？
場違いな質問して申し訳ございませんがどうか
修正したサンプルコードをお願いしたします。
たびたびすみません。
（よねこ） 2020/09/30(水) 19:05

 全然別アプローチで、今のところ全部セルアドレスにできそうだったから・・・
    Function UF_BW(moji As String) As String
        Dim b As String
        Dim r As Range
        Dim x As Range
        b = ""
        If moji Like "*-*" Then
            Set r = Range(Replace(moji, "-", ":"))
            If r.Count > 2 Then
                For Each x In r.Resize(r.Count - 2).Offset(1)
                    b = b & x.Address(0, 0) & ","
                Next x
                b = Mid(b, 1, Len(b) - 1)
            End If
        End If
        UF_BW = b
    End Function

（稲葉） 2020/09/30(水) 19:08

Function UF_BW(moji As String) As String

        Dim b As String
        Dim r As Range
        Dim x As Range
        b = ""
        If moji Like "*-*" Then
            Set r = Range(Replace(moji, "-", ":"))
            If r.Count > 2 Then
                For Each x In r.Resize(r.Count - 2).Offset(1)
                    b = b & x.Address(0, 0) & ","
                Next x
                b = Mid(b, 1, Len(b) - 1)
            End If
        End If
        UF_BW = b
    End Function
このプログラムで列の指定はどこにあるでしょうか？
ちなみに実行するにはどうすればよいでしょうか？
フォームボタンを押すと実行できるようにしたいです。
すみがよろしくお願いいたします。
（よねこ） 2020/09/30(水) 19:19

https://www.sejuku.net/blog/28904

（稲葉） 2020/09/30(水) 19:26

https://valmore.work/excel-vba-function/#i-2
こっちのが分かりやすかった
（稲葉） 2020/09/30(水) 19:30

ありがとうございます。Sub macro()

    Debug.Print (moji)
    End Sub
Function UF_BW(moji As String) As String
        Dim b As String
        Dim r As Range
        Dim x As Range
        b = ""
        If moji Like "*-*" Then
            Set r = Range(Replace(moji, "-", ":"))
            If r.Count > 2 Then
                For Each x In r.Resize(r.Count - 2).Offset(1)
                    b = b & x.Address(0, 0) & ","
                Next x
                b = Mid(b, 1, Len(b) - 1)
            End If
        End If
        UF_BW = b
    End Function
でよろしいでしょうか？
（よねこ） 2020/09/30(水) 19:44

 もっと時間かけて読みなよ
 それでできてるなら、いいんじゃない？
（稲葉） 2020/09/30(水) 19:45

すみません。
マクロを実行しても何も起きません。

今までサンプルコードを参考にしてきたせいか知識としてほとんどありません。
場違いなのはわかっていますがどうかご理解ください。
（よねこ） 2020/09/30(水) 20:59

 イミディエイトウィンドウに何も表示されない、ということですか？

 >Debug.Print (moji)

 参考まで。

https://tonari-it.com/excel-vba-debug-print/
（OK） 2020/09/30(水) 21:11

私は今パソコンから離れスマホから書き込んでいます。
本日はこれ以上のレスは出来ません。
（OK） 2020/09/30(水) 21:14

すみません。
その通りです。
長い時間ありがとうございます。
（OK）様がご教授いただいたコードで
Private Sub CommandButton1_Click()
Dim rng As Range

  Dim c As Range
  Dim celstr As String
  Dim kugiri As String
  Dim kai As Integer
  Dim shu As Integer
  Dim newcelstr As String
  Dim i As Integer
   Set rng = ActiveSheet.Range("L1:L500")
   For Each c In rng
    celstr = c.Value
    celstr = Replace(celstr, "", "")
    sp = Split(celstr, "-")
    kai = sp(0) * 1
    shu = sp(1) * 1
    newcelstr = ""
    For i = kai + 1 To shu - 1
     If newcelstr <> "" Then newcelstr = newcelstr & ","
     newcelstr = newcelstr & "" & i
    Next i
    c.Value = newcelstr
    Erase sp
   Next c
   Set rng = Nothing
End Sub
エラー回避するには
kai = sp(0) * 1をどのように変換すればよろしいでしょうか？
他にも問題があるでしょうか？
ご教授願います。
（よねこ） 2020/09/30(水) 21:21

 標準モジュールにコードいれて
 A1に文字列が記入されているとして、B1セルに表示させたい場合
 B1セル=UF_BW(A1)

 場違いなんて言葉以前に、本気で覚えようとして無いだけに感じますよ。
 そんな態度がみえみえだから、私みたいな性悪に迂遠な回答されちゃうんですよ
（稲葉） 2020/09/30(水) 21:46

すみませんでした。
実行したら,PC1-PC3はB1セルにPC2と表示されましたが、
A1セルにC7,C16,C17,C19,C28-C3やD9-D11,D14,D17,R28,R47,R48-R60,R67の場合は#VALUE!
と出ました。

（よねこ） 2020/10/01(木) 03:41

 >PC1-PC3はB1セルにPC2
 これは仕様通りでないの？
 まさか、ひとつのセルに
 C7,C16,C17,C19,C28-C3
 って入ってるの？

 可能性があるすべてのパターンと求める答えを箇条書きしてください

（稲葉） 2020/10/01(木) 06:16

書きかたが不十分で申し訳ありません。
例を上げると
A2にC7,C16,C17,C19,C28-C3
A3にD9-D11,D14,D17
A4にR28,R47,R48-R60,R67
に入っている場合です。
よろしくお願いします。
（よねこ） 2020/10/01(木) 06:30

興味深く拝見しております。
　
そもそもですが、
「間の文字列を求める」って、どういう局面で求められている話なんですか？
現実との接点とか、そういう話を含めてしてもらえませんか？
　
その文字列というのは、セル範囲のアドレスそのものなんですか？
間じゃないもの（端の文字列）は不要なんですか、
それは既に別の形で求まっているのか、等々。
　
それが説明されていないので、話の向かう先が不透明すぎます。
（γ） 2020/10/01(木) 06:34

2020/10/01(木) 06:30の例で、欲しい結果は何ですか？

（γ） 2020/10/01(木) 06:47

書き方が不十分ですみません。
A2にC7,C16,C17,C19,C28-C30
A3にD9-D11,D14,D17
A4にR28,R47,R48-R60,R67
とした場合、
B2セルにC29
B3セルにD10
B4セルにR49 R50 R51 R52 R53 R54 R55 R56 R57 R58 R59
という結果にしたいです。
プログラムは稲葉様にご教授いただいた、
Sub macro()

    Debug.Print (moji)
    End Sub
Function UF_BW(moji As String) As String
        Dim b As String
        Dim r As Range
        Dim x As Range
        b = ""
        If moji Like "*-*" Then
            Set r = Range(Replace(moji, "-", ":"))
            If r.Count > 2 Then
                For Each x In r.Resize(r.Count - 2).Offset(1)
                    b = b & x.Address(0, 0) & ","
                Next x
                b = Mid(b, 1, Len(b) - 1)
            End If
        End If
        UF_BW = b
    End Function
を使用しています。
よろしくお願いします。

（よねこ） 2020/10/01(木) 06:55

C1,C2,C3,C4 という例があったら何を返すべきですか？

（γ） 2020/10/01(木) 07:14

 D9-D11,D14-D17
 この場合は？

 >>PC1-PC3はB1セルにPC2
 >これは仕様通りでないの
 こっちに対する回答は？
（稲葉） 2020/10/01(木) 07:23

稲葉様

 D9-D11,D14-D17は
b2セルにD10 D15 D16
です。
PC1-PC3はB1セルにPC2
はこれは仕様通りです。
（γ）様
C1,C2,C3,C4場合は何も返さないです。
あくまでもA列内に
 D9-D11,D14-D17などの-を含んでいた際に
その間のD10 D15 D16を隣のB列に返す仕様にしたいです。
申し訳ありませんがお願いします。

（よねこ） 2020/10/01(木) 07:41

コメント拝見しました。ありがとうございます。

2020/10/01(木) 06:34 にも書きましたが、もう少し説明いただきたかった。
本来は、- という書き方をやめて、
すべて列挙する方式に変更したいのではないんですか？

そうであれば、間にある文字列だけでなく、
列挙方式にした場合の、カンマでひとつひとつを連結した文字列を
返すようにしたほうがよいのではないですか？

間の文字列が得られたら、
その次のステップとして、取り出した文字列を反映した全体の文字列が欲しいんです、
とかいう流れになることはないですね？
（γ） 2020/10/01(木) 07:53

 大分終盤になってから横入りすみません。
 こうかな．．．？

    Sub sample()
      Dim aCell As Range

      For Each aCell In Selection
          For Each aStr In Split(aCell.Value, ",")
              aCell.Offset(, 1).Value = aCell.Offset(, 1).Value & InterStr(aStr)
          Next
      Next
    End Sub

    Function InterStr(aStr) As String
       Dim ret()
       InterStr = ""
       If Not aStr Like "*-*" Then Exit Function

       buf = Split(aStr, "-")
       For i = 1 To WorksheetFunction.Min(Len(buf(0)), Len(buf(1)))
           If IsNumeric(Mid(buf(0), i)) And IsNumeric(Mid(buf(0), i)) Then Exit For
       Next
       If Left(buf(0), i - 1) <> Left(buf(1), i - 1) Then Exit Function
       iniLetter = Left(buf(0), i - 1)

       For i = Val(Mid(buf(1), i)) - 1 To Val(Mid(buf(0), i)) + 1 Step -1
           InterStr = "," & iniLetter & i & InterStr
       Next
       InterStr = Mid(InterStr, 2)
    End Function
（´・ω・`） 2020/10/01(木) 07:54

 >取り出した文字列を反映した全体の文字列が欲しいんです
 質問掲示板あるあるですね。
（´・ω・`） 2020/10/01(木) 07:55

    |[A]                    |[B]                                        |[C]         
 [1]|C7,C16,C17,C19,C28-C30 |C29                                        |B1=UF_BW(A1)
 [2]|D9-D11,D14-D17         |D10,D15,D16                                |            
 [3]|R28,R47,R48-R60,R67    |R49,R50,R51,R52,R53,R54,R55,R56,R57,R58,R59|            
 [4]|A1-B2,C1,D5-F5,H1-G1   |A2,B2,A3,B3,D6,E6,F6                       |

 コード（再帰処理）
    Function UF_BW(ByVal moji As String, Optional rec As Boolean = False) As String
        Dim b As String
        Dim c As Variant
        Dim r As Range
        Dim x As Range
        b = ""
        Select Case True
            Case moji Like "*,*"
                For Each c In Split(moji, ",")
                    b = b & UF_BW(c, True)
                Next c
            Case moji Like "*-*"
                Set r = Range(Replace(moji, "-", ":"))
                If r.Count > 2 Then
                    For Each x In r.Resize(r.Count - 2).Offset(1)
                        b = b & x.Address(0, 0) & ","
                    Next x
                End If
            Case Else
                b = ""
        End Select
        If Not rec Then b = Mid(b, 1, Len(b) - 1)
        UF_BW = b
    End Function

 例表にも書いたけど、アルファベットが変わると、セル範囲を行方向にオフセットでループしているので、チグハグな結果になります。

 ＞ >取り出した文字列を反映した全体の文字列が欲しいんです
 ＞質問掲示板あるあるですね。
 いや、ほんとよくありますよね。

 今回も、
 １）Q4-Q8の間のQ5.Q6.Q7
 ↓
 ２）PC1-PC3
 ↓
 ３）A2にC7,C16,C17,C19,C28-C3 
 ↓
 ４）　第４形態　デスタムーアかって・・・
（稲葉） 2020/10/01(木) 08:13

 （´・ω・`） さんの試しました
 D9-D11,D14-D17
 これだけ
 D10D15,D16                                
  ~~↑~
 カンマ入らないっす
（稲葉） 2020/10/01(木) 08:18

 >カンマ入らないっす
 いれわすれました
 誤) aCell.Offset(, 1).Value = aCell.Offset(, 1).Value & InterStr(aStr)
 正) aCell.Offset(, 1).Value = aCell.Offset(, 1).Value & "," & InterStr(aStr)

（´・ω・`） 2020/10/01(木) 08:34

 (;´Д｀)
 私もさっき嵌ったんですが、B列の状態判断してカンマ打ってかないとダメっぽいっす
    |[A]                    |[B]                                            
 [1]|C7,C16,C17,C19,C28-C30 |,,,,,C29                                       
 [2]|D9-D11,D14-D17         |,D10,D15,D16                                   
 [3]|R28,R47,R48-R60,R67    |,,,R49,R50,R51,R52,R53,R54,R55,R56,R57,R58,R59,
 [4]|A1-B2,C1,D5-F5,H1-G1   |,,,,                                           
（稲葉） 2020/10/01(木) 08:41

 >B列の状態判断してカンマ打ってかないとダメっぽいっす
 いま気づきました。
 考え直します。
（´・ω・`） 2020/10/01(木) 08:43

皆さまいろいろとご教授ありがとうございます。
大変勉強になります。
説明が足りないなら遠慮なくおっしゃってください。
よろしくお願いします。

（よねこ） 2020/10/01(木) 12:33

 >説明が足りないなら遠慮なくおっしゃってください。
 いや、いまボールはよねこさんの方にあるのでは？
 回答者から聞かれたことに答えないと。

 考え直しました。

    Sub sample()
      Dim aCell As Range
      For Each aCell In Selection
          aCell.Offset(, 1).Value = InterStr(aCell.Value)
      Next
    End Sub

    Function InterStr(aStr) As String
        InterStr = ""
        For Each bStr In Split(aStr, ",")
            tmpstr = ""
            If bStr Like "*-*" Then
                buf = Split(bStr, "-")
                For i = 1 To WorksheetFunction.Min(Len(buf(0)), Len(buf(1)))
                    If IsNumeric(Mid(buf(0), i)) And IsNumeric(Mid(buf(0), i)) Then Exit For
                Next
                If Left(buf(0), i - 1) <> Left(buf(1), i - 1) Then Exit Function
                iniLetter = Left(buf(0), i - 1)
                For i = Val(Mid(buf(1), i)) - 1 To Val(Mid(buf(0), i)) + 1 Step -1
                    tmpstr = "," & iniLetter & i & tmpstr
                Next
                tmpstr = Mid(tmpstr, 2)
            End If
            If tmpstr <> "" Then InterStr = InterStr & "," & tmpstr
        Next
        InterStr = Mid(InterStr, 2)
    End Function
（´・ω・`） 2020/10/01(木) 13:36

 私の最後のやつは試してもらえたのかしら？
（稲葉） 2020/10/01(木) 14:01

夜分遅くに失礼いたします。
稲葉様のご教授いただいたコードで試したら無事出来ました。
仕様通りです。
ありがとうございました。
（´・ω・`）様のご教授いただいたコードで試したら無事出来ました。
仕様通りです。
ありがとうございました。

皆様大変勉強になりました。

重ね重ね感謝いたします。
（よねこ） 2020/10/02(金) 03:23

コメント返信：

[ 一覧(最新更新順) ]

[[20200930160811]] 『間の文字列を求めるプログラム』（よねこ） ページの最後に飛ぶ

[[20200930160811]]　『間の文字列を求めるプログラム』（よねこ）　ページの最後に飛ぶ