Excel VBA質問箱 IV

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

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


31659 / 76738 ←次へ | 前へ→

【50326】Re:数字をまとめる
回答  ちくたく E-MAIL  - 07/7/19(木) 17:41 -

引用なし
パスワード
   とも さん
こんにちは。

>初心者ですので、出来るかどうかを教えてください。
やろうと思えば、出来ます、出来ると思います。多分。

ちょっと、書いてみましたが、条件分布がスムーズには書けませんでした。
考え方を変えたら、綺麗に書けるのかもしれませんが、
取りあえず、習作を掲載しておきます。
ただし、特に、以下の点で、仕様を満たしておりません。

・繰り上がりの処理を考えていません。
全てし下二桁で表示しています。
こうすべきところを こう
123456,7      123456,57


Sub グルーピング()
  Dim d As Object
  Dim w As Worksheet, nw As Worksheet
  Dim i As Integer, j As Integer, k As Integer
  Dim myItems As Variant, myKeys As Variant
  Dim tmp As Variant
  Dim rNum As Integer
  Dim fl As Integer
  Dim comp As Integer
  
  '連想配列のために辞書を作成
  Set d = CreateObject("Scripting.Dictionary")
  
  For i = 1 To Range("B65536").End(xlUp).Row
    If d.Exists(Range("B" & i).Value) = False Then
      d.Add Range("B" & i).Value, Range("A" & i).Value
    Else
      d.Item(Range("B" & i).Value) = _
      d.Item(Range("B" & i).Value) & "," & _
      Range("A" & i).Value
    End If
  Next i
  
  'ここから書き出し
  Set nw = Worksheets.Add(After:=Worksheets(Worksheets.Count)): nw.Name = "結果整理"
  rNum = 1: fl = 0
  
  With nw
    myKeys = d.keys
    myItems = d.items
    For i = LBound(myKeys) To UBound(myKeys)
      tmp = Split(myItems(i), ",")
      For j = LBound(tmp) To UBound(tmp)
        comp = tmp(j)
        For k = 1 To UBound(tmp) - 1
          If j + k = UBound(tmp) + 1 Then Exit For
          If tmp(j + k) - comp = 1 Then
            fl = fl + 1
            comp = comp + 1
          Else
            Exit For
          End If
        Next k
        Range("A" & rNum) = myKeys(i)
        Select Case fl
          Case 0
            Range("B" & rNum) = tmp(j)
          Case 1
            Range("B" & rNum) = _
            tmp(j) & "," & Right(tmp(j + 1), 2)
          Case Is <= 2
            Range("B" & rNum) = _
            tmp(j) & "〜" & Right(tmp(j + k - 1), 2)
        End Select
        j = j + k - 1: rNum = rNum + 1: fl = 0
      Next j
      
    Next i
  End With

End Sub
0 hits

【50306】数字をまとめる とも 07/7/19(木) 10:36 質問
【50309】Re:数字をまとめる ハチ 07/7/19(木) 11:42 発言
【50312】Re:数字をまとめる ハチ 07/7/19(木) 12:27 発言
【50314】Re:数字をまとめる とも 07/7/19(木) 13:01 お礼
【50321】Re:数字をまとめる ハチ 07/7/19(木) 15:08 発言
【50326】Re:数字をまとめる ちくたく 07/7/19(木) 17:41 回答
【50330】Re:数字をまとめる ハチ 07/7/19(木) 19:58 発言
【50346】Re:数字をまとめる ちくたく 07/7/20(金) 13:38 お礼
【50347】Re:数字をまとめる ちくたく 07/7/20(金) 13:43 発言
【50356】Re:数字をまとめる ハチ 07/7/20(金) 18:33 回答

31659 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free