엑셀 데이터 분석 대사전이란 책의 부록에 있는 Macro 를 옮긴 것이다.
PPM을 이용한 전략을 짜기 위해서 사용했었다.
엑셀 데이터 분석 대사전
Mitsutaks Samejima.Yuji Terada 지음, 윤신례 옮김/영진.com
Sub 거품차트()
Const GrphRngStr As String = "F3:L20"
Const GrphTtlRngStr As String = "A1"
Const BrdClr As Integer = 11
Dim GrphSucStr As String
Dim LastRow As Long
Dim PntObj As Point
Dim i As Integer
LastRow = Range("B65536").End(xlUp).Row
GrphTitleStr = ActiveSheet.Range(GrphTtlRngStr).Value
GrphSucStr = "B4:D" & LastRow
With ActiveSheet.ChartObjects.Add(Left:=Range(GrphRngStr).Left, _
Top:=Range(GrphRngStr).Top, _
Width:=Range(GrphRngStr).Width, _
Height:=Range(GrphRngStr).Height) _
.Chart
.SetSourceData Source:=Range(GrphSucStr), PlotBy:=xlColumns
.ChartType = xlBubble3DEffect
.SeriesCollection.NewSeries
.SeriesCollection(1).XValues = Range("B4:B" & LastRow)
.SeriesCollection(1).Values = Range("C4:C" & LastRow)
.SeriesCollection(1).BubbleSizes = _
"=" & Range("D4:D" & LastRow).Address(ReferenceStyle:=xlR1C1, External:=True)
.SeriesCollection(3).Delete
.SeriesCollection(2).Delete
.HasTitle = True
.ChartTitle.Text = GrphTitleStr
.HasLegend = False
.ChartGroups(1).VaryByCategories = True
.Axes(xlCategory) _
.TickLabelPosition = xlTickLabelPositionLow
.Axes(xlValue) _
.TickLabelPosition = xlTickLabelPositionLow
With .Axes(xlValue)
.CrossesAt = (.MinimumScale + .MaximumScale) / 2
.MajorTickMark = xlCross
With .Border
.ColorIndex = BrdClr
.Weight = xlMedium
.LineStyle = xlContinuous
End With
End With
With .Axes(xlCategory)
.CrossesAt = (.MinimumScale + .MaximumScale) / 2
.MajorTickMark = xlCross
With .Border
.ColorIndex = BrdClr
.Weight = xlMedium
.LineStyle = xlContinuous
End With
End With
End With
i = 1
With ActiveSheet
.ChartObjects(.ChartObjects.Count).Activate
End With
ActiveChart.ApplyDataLabels
With Range("A4:A" & LastRow)
For Each PntObj In ActiveChart.SeriesCollection(1).Points
PntObj.DataLabel.Text = .Cells(i).Value
i = i + 1
Next PntObj
Set PntObj = Nothing
End With
ActiveSheet.Range("G6").Activate
End Sub
Sub 항목명이동()
Dim PntObj As Point
Dim LftMove As Single
이동거리입력:
LftMove = Application.InputBox( _
Prompt:="왼쪽으로 이동할 항목명의 거리를 입력해주세요" & vbCrLf & _
"(포인트 단위) +의 값은 왼쪽에, -값은 오른쪽으로 항목명이; 이동합니다. ", _
Title:="항목명의 이동 거리 입력", _
Type:=1)
If LftMove = False Then
Exit Sub
End If
With ActiveSheet
.ChartObjects(.ChartObjects.Count).Activate
End With
ActiveChart.ApplyDataLabels
For Each PntObj In ActiveChart.SeriesCollection(1).Points
With PntObj.DataLabel
If LftMove > .Left Then
MsgBox "값이 넘어가지 않도록 다시 입력하세요"
GoTo 이동거리입력
Else
.Left = .Left - LftMove
End If
End With
Next PntObj
Set PntObj = Nothing
ActiveSheet.Range("G6").Activate
End Sub