Home
Blog
Inquire
ＶＢＡ

ＶＢＡ--- エクセル：シートの上方で入力した表の集計を、シートの下方に表示


　（例えば、売上先ごとの売上金額の集計を同シートの下方に表示したいというリクエストに応えて作成してみました。
　シート上のボタンをクリックしたタイミングで実行（説明は省略）

 Sub Button_onClick()
  Dim endcolcnt,colcnt,vSak,vKingaku,startrow,endrowcnt As Long
  Dim colnm As String
  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
  With ActiveSheet
   endcolcnt = .Range("XFD2").End(xlToLeft).Column
   For colcnt = 1 To endcolcnt
    If .Cells(2, colcnt) = "販売先" Then
     vSaki = colcnt
    ElseIf .Cells(2, colcnt) = "売上金額" Then
     vKingaku = colcnt
    End If
   Next colcnt
   colnm = Split(Cells(1, vSaki).Address, "$")(1)
   startrowcnt = .Range(colnm & 2).End(xlDown).Row + 1
   endrowcnt = .Range(colnm  & Cells.Rows.Count).End(xlUp).Row
   .Rows(startrowcnt & ":" & endrowcnt).Delete
   Range(.Cells(2, 1), .Cells(2, endcolcnt)).Copy
   .Range("A500").PasteSpecial (xlPasteAll)
   orowcnt = 501
   endrowcnt = startrowcnt - 1
   For rowcnt = 3 To endrowcnt
    If .Cells(rowcnt, vSaki) <> "" Then    
     .Cells(orowcnt, vSaki) = .Cells(rowcnt, vSaki)
     .Cells(orowcnt, vKingaku) = .Cells(rowcnt, vKingaku)
    End if
   Next rowcnt
   endrowcnt = .Range(colnm & Cells.Rows.Count).End(xlUp).Row
   .Range("A501:Z" & endrowcnt).Sort Key1:=Range(colnm & 501), Order1:=xlAscending
   For rowcnt = 502 To endrowcnt
    If .Cells(rowcnt, vSaki) = .Cells(rowcnt, vSaki) Then
     .Cells(orowcnt, vSaki) = .Cells(rowcnt, vSaki)
     .Cells(orowcnt, vKingaku) = .Cells(rowcnt, vKingaku)
     If orowcnt <> rowcnt Then
      .Cells(orowcnt, vSaki).ClearContents
      .Cells(orowcnt, vKingaku).ClearContents
     End If
    End If
   Next rowcnt
  End With
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  MsgBox "end!"
 End Sub

©2018KanazawaNoSakai