저는 제가 필요할 때마다 검색하고 응용해서 사용하는 편이라 대부분의 초보사용자가
불편해 하는 부분을 잘 알 수가 없어요. 그래서 댓글이 달릴 때마다 혹은 개인적으로
메일을 보내오시는 분, 쪽지를 보내오시는 분의 요구사항을 해결해 드릴려고 합니다.
1. (x,y) 분산차트 그린다음에 개별 표식 옆에 별도 이름 입력하는거랑
2. 저렇게 동적으로 차트 생성한다음에 맨 마지막이나 특정중간 범위에 표식이랑 색깔
을 달리한다든가..
3. 동적차트 그린다음에 text 추가 삽입하는거.. 혹은 그 삽입 위치 지정같은거요..
우선 1. 분산챠트 부분은 그냥 영역선택하고 그래프 종류 선택해서 그리면 되지만
표식 옆에 다른 내용을 넣고자 하면 힘이 많이 들지요. 그래서 VBA로 넣고 싶은
내용을 자료와 연계해서 넣고 강조할 부분이 있으면 Marker 등을 변형해서 그 부분이
강조되게 하는 것입니다.
Option Explicit
Public dTime As Date
우선 차트를 그릴 영역을 선택하고 차트를 그립니다.
Sub ChartFromRange()
Dim myChtObj As ChartObject
Dim rngChtData As Range
Dim rngChtXVal As Range
Dim iColumn As Long
‘ 선택영역이 없으면 실행 중지
If TypeName(Selection) <> “Range” Then
MsgBox “영역을 선택하세요”
Exit Sub
End If
‘ 선택된 영역을 챠트데이터로 지정
Set rngChtData = Selection
‘ X값 재정의
With rngChtData
Set rngChtXVal = .Columns(1).Offset(1).Resize(.Rows.Count – 1)
End With
‘ 기존 차트가 있으면 삭제
For Each myChtObj In ActiveSheet.ChartObjects
If myChtObj.Name = “Chart 6” Then
myChtObj.Delete
End If
Next
‘ 챠트 생성
Set myChtObj = ActiveSheet.ChartObjects.Add _
(Left:=300, Width:=180, Top:=290, Height:=180)
myChtObj.Name = “Chart 6”
With myChtObj.Chart
‘ 분산형 챠트
.ChartType = xlXYScatter
‘ 다른 시리즈 제거
Do Until .SeriesCollection.Count = 0
.SeriesCollection(1).Delete
Loop
‘ 세로축 만들기
With .Axes(xlCategory)
.HasMajorGridlines = True
.MajorGridlines.Border.Color = RGB(0, 0, 0)
.MajorGridlines.Border.LineStyle = xlContinuous
End With
‘ 범례 표시 보이지 않음
.HasLegend = False
‘ 강제로 제목을 보이지 않음. 기본으로 보이므로 보였다 안보이게
.HasTitle = True
.HasTitle = False
‘ 선택된 영역으로 차트 그리기
For iColumn = 2 To rngChtData.Columns.Count
With .SeriesCollection.NewSeries
.Values = rngChtXVal.Offset(, iColumn – 1)
.XValues = rngChtXVal
.Name = rngChtData(1, iColumn)
End With
Next
End With
‘ 챠트 꾸미기
Call ShadowMarker
‘ 차트에 값 표시
Call LabelXYValue
End Sub
챠트 꾸미기
Sub ShadowMarker()
Dim excChart As Chart
Dim excChartSeries As Series
Dim excPoint As Point
Set excChart = ActiveSheet.ChartObjects(“Chart 6”).Chart
Set excChartSeries = excChart.SeriesCollection(1)
With excChartSeries
‘그림자 설정
For Each excPoint In .Points
.Shadow = True
.MarkerBackgroundColor = RGB(255, 255, 255)
.MarkerForegroundColor = RGB(0, 176, 80)
.Format.Shadow.Type = msoShadow38
.Format.Shadow.Blur = 5
.Format.Shadow.ForeColor.RGB = RGB(0, 176, 80)
.MarkerSize = 12
.MarkerStyle = xlMarkerStyleCircle
Next
End With
End Sub
차트에 값 표시
Sub LabelXYValue()
Dim i As Integer, j As Integer
Dim excChart As Chart
Dim excShpTxt As Shape
Dim excChartSeries As Series
Dim cel As Range
Dim TempRng As Range
Dim vXValues As Variant
Dim vYValues As Variant
Dim iPt As Long
Dim YValMax As Double
Dim iPtMax As Long
Set TempRng = Range(“Ref_Rng”)
Set excChart = ActiveSheet.ChartObjects(“Chart 6”).Chart
Set excShpTxt = excChart.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 150, 12)
Set excChartSeries = excChart.SeriesCollection(1)
‘ Y값이 최대값을 가지는 x값 찿음
For iPt = 2 To UBound(vYValues)
If vYValues(iPt) > YValMax Then
YValMax = vYValues(iPt)
iPtMax = iPt
End If
Next
For i = 1 To .SeriesCollection(2).Points.Count
With .SeriesCollection(2).Points(i)
‘ 최대값이면 표시, 이 부분에 조건을 넣어서 표시하면 됨
If i = iPtMax Then
.DataLabel.Font.Size = 10
.DataLabel.Font.Color = vbBlue
.DataLabel.Text = Format(vYValues(i), “0.00”)
Else
.DataLabel.Text = “”
End If
End With
Next i
End With
End Sub
Sub MarkerOutY()
Dim i As Integer, j As Integer
Dim excChart As Chart
Dim excChartSeries As Series
Dim vYValues As Variant
Dim Spec_Center As Long
Spec_Center = 42#
Set excChart = ActiveSheet.ChartObjects(“Chart 5”).Chart
Set excChartSeries = excChart.SeriesCollection(1)
With excChart
With excChartSeries
.ApplyDataLabels
.MarkerStyle = xlMarkerStyleNone
5월 7 2015
엑셀(EXCEL) – Animation Chart의 데이터 강조 및 분산 챠트의 다양한 표시법
앞의 팁에서 ‘게을러져라’라고 했는데 그 게으럼을 위하여 필요한 도구나 방법을
찾아내어 응용하는 것 즉 ‘필요는 발명의 어머니’입니다. 아래 팁에 달린 댓글에
댓글 달아주신 분이 필요해서 자료를 찾아보고 정리한 내용 올립니다.
http://www.clien.net/cs2/bbs/board.php?bo_table=lecture&wr_id=269998
저는 제가 필요할 때마다 검색하고 응용해서 사용하는 편이라 대부분의 초보사용자가
불편해 하는 부분을 잘 알 수가 없어요. 그래서 댓글이 달릴 때마다 혹은 개인적으로
메일을 보내오시는 분, 쪽지를 보내오시는 분의 요구사항을 해결해 드릴려고 합니다.
1. (x,y) 분산차트 그린다음에 개별 표식 옆에 별도 이름 입력하는거랑
2. 저렇게 동적으로 차트 생성한다음에 맨 마지막이나 특정중간 범위에 표식이랑 색깔
을 달리한다든가..
3. 동적차트 그린다음에 text 추가 삽입하는거.. 혹은 그 삽입 위치 지정같은거요..
우선 1. 분산챠트 부분은 그냥 영역선택하고 그래프 종류 선택해서 그리면 되지만
표식 옆에 다른 내용을 넣고자 하면 힘이 많이 들지요. 그래서 VBA로 넣고 싶은
내용을 자료와 연계해서 넣고 강조할 부분이 있으면 Marker 등을 변형해서 그 부분이
강조되게 하는 것입니다.
Option Explicit
Public dTime As Date
우선 차트를 그릴 영역을 선택하고 차트를 그립니다.
Sub ChartFromRange()
Dim myChtObj As ChartObject
Dim rngChtData As Range
Dim rngChtXVal As Range
Dim iColumn As Long
‘ 선택영역이 없으면 실행 중지
If TypeName(Selection) <> “Range” Then
MsgBox “영역을 선택하세요”
Exit Sub
End If
‘ 선택된 영역을 챠트데이터로 지정
Set rngChtData = Selection
‘ X값 재정의
With rngChtData
Set rngChtXVal = .Columns(1).Offset(1).Resize(.Rows.Count – 1)
End With
‘ 기존 차트가 있으면 삭제
For Each myChtObj In ActiveSheet.ChartObjects
If myChtObj.Name = “Chart 6” Then
myChtObj.Delete
End If
Next
‘ 챠트 생성
Set myChtObj = ActiveSheet.ChartObjects.Add _
(Left:=300, Width:=180, Top:=290, Height:=180)
myChtObj.Name = “Chart 6”
With myChtObj.Chart
‘ 분산형 챠트
.ChartType = xlXYScatter
‘ 다른 시리즈 제거
Do Until .SeriesCollection.Count = 0
.SeriesCollection(1).Delete
Loop
‘ 세로축 만들기
With .Axes(xlCategory)
.HasMajorGridlines = True
.MajorGridlines.Border.Color = RGB(0, 0, 0)
.MajorGridlines.Border.LineStyle = xlContinuous
End With
‘ 범례 표시 보이지 않음
.HasLegend = False
‘ 강제로 제목을 보이지 않음. 기본으로 보이므로 보였다 안보이게
.HasTitle = True
.HasTitle = False
‘ 선택된 영역으로 차트 그리기
For iColumn = 2 To rngChtData.Columns.Count
With .SeriesCollection.NewSeries
.Values = rngChtXVal.Offset(, iColumn – 1)
.XValues = rngChtXVal
.Name = rngChtData(1, iColumn)
End With
Next
End With
‘ 챠트 꾸미기
Call ShadowMarker
‘ 차트에 값 표시
Call LabelXYValue
End Sub
챠트 꾸미기
Sub ShadowMarker()
Dim excChart As Chart
Dim excChartSeries As Series
Dim excPoint As Point
Set excChart = ActiveSheet.ChartObjects(“Chart 6”).Chart
Set excChartSeries = excChart.SeriesCollection(1)
With excChartSeries
‘그림자 설정
For Each excPoint In .Points
.Shadow = True
.MarkerBackgroundColor = RGB(255, 255, 255)
.MarkerForegroundColor = RGB(0, 176, 80)
.Format.Shadow.Type = msoShadow38
.Format.Shadow.Blur = 5
.Format.Shadow.ForeColor.RGB = RGB(0, 176, 80)
.MarkerSize = 12
.MarkerStyle = xlMarkerStyleCircle
Next
End With
End Sub
차트에 값 표시
Sub LabelXYValue()
Dim i As Integer, j As Integer
Dim excChart As Chart
Dim excShpTxt As Shape
Dim excChartSeries As Series
Dim cel As Range
Dim TempRng As Range
Dim vXValues As Variant
Dim vYValues As Variant
Dim iPt As Long
Dim YValMax As Double
Dim iPtMax As Long
Set TempRng = Range(“Ref_Rng”)
Set excChart = ActiveSheet.ChartObjects(“Chart 6”).Chart
Set excShpTxt = excChart.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 150, 12)
Set excChartSeries = excChart.SeriesCollection(1)
With excChart
excShpTxt.Left = .PlotArea.Left
excShpTxt.Top = .PlotArea.Top
excShpTxt.TextFrame.Characters.Font.Color = vbBlue
With excShpTxt.TextFrame2
.TextRange.Text = “특정 영역에 Text넣기”
.AutoSize = msoAutoSizeShapeToFitText
End With
vXValues = .SeriesCollection(1).XValues
vYValues = .SeriesCollection(1).Values
YValMax = vYValues(1)
iPtMax = 1
For iPt = 2 To UBound(vYValues)
If vYValues(iPt) > YValMax Then
YValMax = vYValues(iPt)
iPtMax = iPt
End If
Next
For i = 1 To .SeriesCollection(1).Points.Count
‘ With .SeriesCollection(1).Points(i)
‘ .ApplyDataLabels
‘
‘ If i = iPtMax Then
‘ .MarkerBackgroundColor = RGB(255, 0, 0)
‘ .MarkerForegroundColor = RGB(0, 0, 0)
‘ .Format.Shadow.Blur = 5
‘ .MarkerSize = 12
‘ .MarkerStyle = xlMarkerStyleDiamond
‘ .DataLabel.Text = “(” & vXValues(i) & “,” & vYValues(i) & “)”
‘
‘ Else
‘ .DataLabel.Text = “(” & vXValues(i) & “,” & vYValues(i) & “)”
‘
‘ End If
‘
‘ End With
With .SeriesCollection(1).Points(i)
.ApplyDataLabels
For Each cel In TempRng
If cel.Value = vXValues(i) Then
.DataLabel.Text = cel.Offset(0, 1).Value
End If
Next
End With
Next i
End With
Set cel = Nothing
Set TempRng = Nothing
End Sub
2. 동적차트에 특정 표시랑 색깔 다르게 하기
그냥 아이디어가 없어? R의 최대값과 Spec Out된 자료를 보여주는 정도로 했습니다.
아래 루틴에서 힌트를 얻어 다양한 방법으로 자료를 표시할 수 있으실 것입니다.
Sub LabelRMax()
Dim i As Integer
Dim excChart As Chart
Dim excShpTxt As Shape
Dim excChartSeries As Series
Dim vXValues As Variant
Dim vYValues As Variant
Dim iPt As Long
Dim YValMax As Double
Dim iPtMax As Long
Set excChart = ActiveSheet.ChartObjects(“Chart 5”).Chart
Set excChartSeries = excChart.SeriesCollection(2)
With excChart
With excChartSeries
.ApplyDataLabels
.MarkerStyle = xlMarkerStyleNone
.Format.Line.Visible = msoFalse
.Format.Line.Visible = msoTrue
.Format.Line.DashStyle = msoLineSolid
.Format.Line.ForeColor.RGB = RGB(255, 0, 0)
.Format.Line.Weight = 1#
End With
vYValues = .SeriesCollection(2).Values
YValMax = vYValues(1)
iPtMax = 1
‘ Y값이 최대값을 가지는 x값 찿음
For iPt = 2 To UBound(vYValues)
If vYValues(iPt) > YValMax Then
YValMax = vYValues(iPt)
iPtMax = iPt
End If
Next
For i = 1 To .SeriesCollection(2).Points.Count
With .SeriesCollection(2).Points(i)
‘ 최대값이면 표시, 이 부분에 조건을 넣어서 표시하면 됨
If i = iPtMax Then
.DataLabel.Font.Size = 10
.DataLabel.Font.Color = vbBlue
.DataLabel.Text = Format(vYValues(i), “0.00”)
Else
.DataLabel.Text = “”
End If
End With
Next i
End With
End Sub
Sub MarkerOutY()
Dim i As Integer, j As Integer
Dim excChart As Chart
Dim excChartSeries As Series
Dim vYValues As Variant
Dim Spec_Center As Long
Spec_Center = 42#
Set excChart = ActiveSheet.ChartObjects(“Chart 5”).Chart
Set excChartSeries = excChart.SeriesCollection(1)
With excChart
With excChartSeries
.ApplyDataLabels
.MarkerStyle = xlMarkerStyleNone
.Format.Line.Visible = msoFalse
.Format.Line.Visible = msoTrue
.Format.Line.DashStyle = msoLineSolid
.Format.Line.ForeColor.RGB = RGB(0, 0, 255)
.Format.Line.Weight = 1#
End With
vYValues = .SeriesCollection(1).Values
For i = 1 To .SeriesCollection(1).Points.Count
With .SeriesCollection(1).Points(i)
‘ Spec Out된 Y값 표시, 부분에 조건을 넣어서 표시하면 됨
If Abs(vYValues(i) – Spec_Center) > 3 Then
.DataLabel.Font.Size = 10
.DataLabel.Font.Color = vbRed
.DataLabel.Text = Format(vYValues(i), “0.00”)
Else
.DataLabel.Text = “”
End If
End With
Next i
End With
End Sub
Sub SetReDraw()
Dim ws As Worksheet
Set ws = Sheets(“Chart”)
On Error Resume Next
‘ 현재 시간 표시
ws.Cells(20, 8) = Now()
‘ 스크롤 위치 조정, ‘1’ 값을 조정하면 폭을 조절가능
Range(“스크롤”).Value = Range(“스크롤”).Value + 1
‘ 스크롤위치가 데이터크기보다 크면 리셋
If Range(“스크롤”).Value > Cells(20, 7).Value Then
Range(“스크롤”).Value = 1
End If
‘ 자동 스크롤 단위 시간, 분, 초
dTime = Now + TimeValue(“00:00:01”)
‘ R 최대값에 Label
Call LabelRMax
‘ 불량 데이터 표시
Call MarkerOutY
‘ 자동 스크롤
Application.OnTime dTime, “SetReDraw”
End Sub
Sub StopSetReDraw()
On Error Resume Next
‘ 자동 스크롤 중지
Application.OnTime dTime, “SetReDraw”, , False
End Sub
3. 3번은 고민중에 있습니다. 1초에 하나씩 Text가 생기고 또 없애야 해서
루틴의 아이디어를 찾아야 하는데 “게을러서… ” 해결되면 추가 수정해 두겠습니다.
언제나처럼 엑셀자료는 제 블로그에 올리겠습니다.
첨부 화일 : 20150507v1-Ani-Cht-Sct-Label
By vinipapa • 무른모 • 0 • Tags: Excel, 데이터 강조, 분산챠트, 애니메이션차트, 엑셀