MW211 EXIT

devlog
ExcelVBA/塊ごとに番号
2018年07月31日
キー列の値が同じ行が続くものを塊ともなし、
その塊ごとに番号を振る方法はないようなので、マクロを組んだ。

以下のような番号(二列目)を振りたいわけだ。
┌─┬─┐
│A │ 1│
├─┼─┤
│A │ 1│
├─┼─┤
│B │ 1│
├─┼─┤
│A │ 2│
├─┼─┤
│C │ 1│
├─┼─┤
│A │ 3│
└─┴─┘

┌──────────────────────────────────────┐
│Const X_キー As Long = 1                                                    │
│Const X_番号 As Long = 2                                                    │
│Dim yMax As Long, y1 As Long, y2 As Long                                    │
│Dim 番号 As Long, is違 As Boolean                                           │
│With シート                                                                 │
│    yMax = .UsedRange.Rows(.UsedRange.Rows.Count).Row                       │
│    .Columns(X_番号).ClearContents                                          │
│    For y1 = 1 To yMax                                                      │
│        If .Cells(y1, X_番号).Value = "" Then                               │
│            is違 = False                                                    │
│            番号 = 1                                                        │
│            For y2 = y1 To yMax                                             │
│                If .Cells(y2, X_キー).Value = .Cells(y1, X_キー).Value Then │
│                    If is違 Then                                            │
│                        is違 = False                                        │
│                        番号 = 番号 + 1                                     │
│                    End If                                                  │
│                    .Cells(y2, X_番号).Value = 番号                         │
│                Else                                                        │
│                    is違 = True                                             │
│                End If                                                      │
│            Next y2                                                         │
│        End If                                                              │
│    Next y1                                                                 │
│End With                                                                    │
└──────────────────────────────────────┘
分類:ExcelVBA