Dim i As Integer     '数字カウント
Dim tel As Integer   '総数
'
Sub ki274()
Sheets("Sheet1").Select
bbb = ActiveWorkbook.Name
'最終セル
    Range("A1").Select
    Selection.End(xlDown).Select
    encel1 = ActiveCell.Address
    cend = Mid(encel1, 4)
'並び替え
    If InStr(1, Cells(cend, 1), "他", 1) > 0 Then
       cenda = cend - 1
    Else
       cenda = cend
    End If

    Range(Cells(2, 1), Cells(cenda, 2)).Select
    Selection.SortSpecial SortMethod:=xlSyllabary, Key1:=Range("B1"), _
        Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom
    Range("A1").Select
'数値合計
     tel = 0
    For i = 2 To cend
        tel = tel + Cells(i, 2)
    Next
        Cells(cend + 1, 2) = tel
'パ−セント
    For i = 2 To cend
        Cells(i, 3).NumberFormat = "0"
        If i = 2 Then
            Cells(i, 3) = Cells(i, 2) / tel * 100
        Else
            Cells(i, 3) = Cells(i, 2) / tel * 100 + Cells(i - 1, 3)
        End If
    Next
    
' グラフ作成
     Range(Cells(2, 1), Cells(cend, 2)).Select
    ActiveSheet.ChartObjects.Add(132.75, 183, 353.25, 192).Select
    Application.CutCopyMode = False
    ActiveChart.ChartWizard Source:=Range(Cells(2, 1), Cells(cend, 3)), Gallery:= _
        xlCombination, Format:=2, PlotBy:=xlColumns, CategoryLabels:=1 _
        , SeriesLabels:=0, HasLegend:=2, Title:="", CategoryTitle:= _
        "", ValueTitle:="", ExtraTitle:=""
    Range("H10").Select
    
' グラフ名取得
   ActiveSheet.ChartObjects.Select
    cnam = Selection.Name
    ActiveSheet.DrawingObjects(cnam).Select
    ActiveSheet.ChartObjects(cnam).Activate
    
    ActiveChart.SeriesCollection(1).Select
    Selection.ApplyDataLabels Type:=xlShowValue, LegendKey:=False
    Selection.DataLabels.Select
'最大値・最小値指定
    With ActiveChart.Axes(xlValue)
        .MinimumScale = 0
        .MaximumScale = tel
    End With
  
    ActiveSheet.ChartObjects(cnam).Activate
    ActiveChart.Axes(xlValue, xlSecondary).Select
     With ActiveChart.Axes(xlValue, xlSecondary)
        .MinimumScaleIsAuto = True
        .MaximumScale = 100
    End With
       Windows(bbb).Activate
    Range("K6").Select
        
'総数の表示（必要に応じグラフの好みの場所に入れて下さい）
    ActiveSheet.TextBoxes.Add(274.5, 81.75, 47.25, 13.5).Select
    Selection.Characters.Text = "N=" & tel
    Selection.Border.LineStyle = xlNone
    Selection.Interior.ColorIndex = xlNone
    Range("C13").Select
    
End Sub