メモ

主にプログラミング系の備忘録

ドラッグ・フィルを拾ってみた

Dim bFlag As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
  Static sAfter As String '更新後のセル範囲アドレス
  Static sBefore As String '更新前のセル範囲アドレス
  
  If Target.Row <= 5 Or Target.Column <= 5 Then Exit Sub
  If bFlag Then Exit Sub
  
    sAfter = Selection.Address(True, True, xlR1C1)
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
    sBefore = Selection.Address(True, True, xlR1C1)
  
    'ここから処理
    Dim nAfterStartRow As Long
    Dim nAfterEndRow As Long
    Dim nAfterStartCol As Long
    Dim nAfterEndCol As Long
    Dim nBeforeStartRow As Long
    Dim nBeforeEndRow As Long
    Dim nBeforeStartCol As Long
    Dim nBeforeEndCol As Long
    Dim temp As String
    
    nAfterStartRow = Mid(sAfter, 2, InStr(1, sAfter, "C") - 2)
    nAfterEndCol = Right(sAfter, Len(sAfter) - InStrRev(sAfter, "C"))
    If InStr(1, sAfter, ":") > 0 Then
      nAfterStartCol = Mid(sAfter, InStr(1, sAfter, "C") + 1, InStr(1, sAfter, ":") - InStr(1, sAfter, "C") - 1)
      nAfterEndRow = Mid(sAfter, InStrRev(sAfter, "R") + 1, InStrRev(sAfter, "C") - InStrRev(sAfter, "R") - 1)
    Else
      nAfterStartCol = nAfterEndCol
      nAfterEndRow = nAfterStartRow
    End If
     
    nBeforeStartRow = Mid(sBefore, 2, InStr(1, sBefore, "C") - 2)
    nBeforeEndCol = Right(sBefore, Len(sBefore) - InStrRev(sBefore, "C"))
    If InStr(1, sBefore, ":") > 0 Then
      nBeforeStartCol = Mid(sBefore, InStr(1, sBefore, "C") + 1, InStr(1, sBefore, ":") - InStr(1, sBefore, "C") - 1)
      nBeforeEndRow = Mid(sBefore, InStrRev(sBefore, "R") + 1, InStrRev(sBefore, "C") - InStrRev(sBefore, "R") - 1)
    Else
      nBeforeStartCol = nBeforeEndCol
      nBeforeEndRow = nBeforeStartRow
    End If   

    If nAfterEndRow <> nBeforeEndRow Or nAfterStartRow <> nBeforeStartRow Then
      MsgBox "行をまたいだ変更"
    ElseIf nAfterStartCol > nBeforeStartCol Then '起点が変わっている→後ろ倒し
      MsgBox "後倒し"
    ElseIf nAfterStartCol < nBeforeStartCol Then '起点が変わっている→前倒し
      MsgBox "前倒し"
    ElseIf nAfterEndCol > nBeforeEndCol Then '終点が変わっている→延長
      MsgBox "延長"
    ElseIf nAfterEndCol < nBeforeEndCol Then '終点が変わっている→短縮
      MsgBox "短縮"
    Else
      MsgBox "変更なし"
    End If
    If nAfterEndRow = nBeforeEndRow And nAfterStartRow = nAfterStartRow Then
      Application.EnableEvents = False
      Application.Undo
      Application.EnableEvents = True
    End If
    
    bFlag = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'  Debug.Print "Call selectionChange"
  bFlag = False
  
End Sub