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
5월 12 2015
나눔-엑셀(EXCEL) – 중복되지않는 난수,동적이름정의, Timer를 이용한 추첨 방법
회사에 낙하산?이 떨어지는 바람에 사무실 전체의 배치를 바꾸고 기존 책상을
새 책상으로 바꾸다 보니 서랍 구석에 숨겨져 있는 유물 RAM을 발견했습니다.
2012 Mac mini에서 적출한 PC3-10600S 2GB * 2EA의 노트북용 램이라서
아직은 쓸만하다고 생각되어 나눔을 하고자 합니다.
그냥 드릴려고 하다가 팁란에도 쓰고 혹시나 사무실에서 특정 시간을 정해 놓고
간식 내기 등에 유용하게 사용하시면 좋을 것 같아 제목과 같은 팁을 올려봅니다.
기존의 팁을 잘 읽으신 분들이라면 쉽게 적응하실 수 있을 것으로 보입니다.
일반적으로 난수를 발생시켜 정수(intger)값을 얻으면 중복된 값이 많이 나타나게
됩니다. 예로 =INT(RAND()*100)로 1~100까지 난수를 발생시키면 대부분의 경우
몇 개가 중복으로 나타납니다. 이것을 해결하기 위한 팁을 응용한 예제입니다.
우선 동적 이름 정의를 이용하여 지속적으로 변하는 신청자의 추가, 삭제를 자동으로
확장, 축소할 수 있도록 당첨자(순위)를 동적이름으로 정의합니다. 순위를 이용하여
벌금이나 혜택을 정할 수도 있지만 여기서는 난수를 발생시켜 그 난수와 일치하는
사람을 추첨하기로 합니다.
=OFFSET(Sheet1!$H$2,0,0,COUNTA(Sheet1!$H:$H)-1,1)
Timer를 이용하여 지속적으로 난수를 발생시킵니다. G2셀에 아래를 입력합니다.
그냥 난수를 발생시켜도 되지만 그냥 에러 처리 차원에서 이메일 주소가 유효한지
점검하는데 여러 방법이 있는데 아래와 같이 처리했습니다.
=IF(ISNUMBER(FIND(“@”,F2,1))=TRUE, RAND(), “”)
B7 셀에도 난수를 발생시켜 행운의 숫자를 만듭니다. (row_cnt는 신청자 수)
lucky_no = Int(Cells(7, 2).Value * row_cnt)
이 팁의 주요한 내용인 Rank함수를 이용하여 반복없는 난수를 얻어 순위를 정하고
동적이름정의를 활용해서 추가 삭제되는 난수를 자동으로 영역위치에 넣어줍니다.
=RANK(G2,중복없는난수)
물론 “중복없는난수”도 동적이름으로 정의되어 있습니다.
=OFFSET(Sheet1!$G$2,0,0,COUNTA(Sheet1!$G:$G)-1,1)
“참가자’도 동적이름으로 정의하여 나중에 특정영역을 복사할 수 있는 Row값을
얻을 수 있도록 합니다. 이것은 Start_Lucky_Break에서 이용할 것입니다.
=OFFSET(Sheet1!$F$2,0,0,COUNTA(Sheet1!$F:$F)-1,1)
이제 Timer를 동작시켜 특정한 지정한 시간이 되면 당첨자를 알려줍니다.
첨부된 엑셀화일을 열어 매크로 사용가능하게 하시고 Specific Time에서 시각을
지정하면 1초 단위로 난수를 발생시켜 지정된 시간이 되면 당첨자를 보여줍니다.
Public dTime As Date
Sub SetReminder()
On Error Resume Next
Dim ws As Worksheet
Set ws = Sheets(“Sheet1”)
ws.Cells(5, 2) = Now
‘1초단위로 타이머동작, 여기서 타이머의 동작시간 변경
dTime = Now + TimeValue(“00:00:01”)
Application.OnTime dTime, “SetReminder”
‘지정된 시간에 Sub문 실행, 여기에 if나 switch문으로 여러가지 일을 시킬 수 있음
If Time = TimeSerial(ws.Cells(3, 2), ws.Cells(3, 3), ws.Cells(3, 4)) Then
Call Start_Lucky_Break
End If
End Sub
Sub StopSetReminder()
‘ 실행 중지
On Error Resume Next
Application.OnTime dTime, “SetReminder”, , False
End Sub
Sub Start_Lucky_Break()
Dim row_cnt As Integer, lucky_no As Integer
Dim cell As Range
Dim rng As Range
Dim msg As String
msg = “축하합니다.” & vbCrLf
msg = msg + ” 받으실 주소와 전화번호를 쪽지로 주세요” & vbCrLf
‘ 참가자의 수를 얻는 여러 방법들과 난수의 크기를 결정
‘ row_cnt = Application.CountA(Range(“F2”, Range(“F2”).End(xlDown)))
‘ row_cnt = Application.CountA(Range(“참가자”))
‘ row_cnt = Range(“참가자”).Rows.Count
‘ row_cnt = Sheet1.UsedRange.Rows.Count – 2
‘ row_cnt = Sheet1.Range(“F1”).CurrentRegion.Rows.Count – 1
row_cnt = Sheet1.Range(“F65536”).End(xlUp).Row – 1
‘ 수식이 있는 영역을 지원자만큼 선택하여 복사, 붙여넣기
Range(“G2:H2”).Select
Selection.AutoFill Destination:=Range(“G2:H” & row_cnt + 1)
Range(“F2”).Select
‘ 행운의 숫자 생성
lucky_no = Int(Cells(7, 2).Value * row_cnt)
Set rng = Range(“당첨자”)
‘ 행운의 숫자와 같은 사람의 E-mail주소 추출
For Each cell In rng
If cell.Value = lucky_no Then
MsgBox msg & lucky_no & ” : ” & cell.Offset(0, -2).Text
End If
Next
‘ 추첨이 끝났으니 타이머 중지
Call StopSetReminder
End Sub
첨부화일 : 20150512-Share_RAM
==========================================================
* 신청하실 분들은 쪽지나 댓글, 메일로 주시면 됩니다.
2015년 05월 15일 12시 00분 정오까지 신청한 분들을 대상으로 추첨해서
보내드리도록 하겠습니다. 잘 사용하다 업그레이드하면서 빼 놓은 것이라
정상작동하겠지만 혹시나 동작하지 않을 수도 있습니다.
By vinipapa • 무른모 • 0 • Tags: 나눔, 동적이름, 램, 엑셀, 중복되지않는 난수, 타이머