VB(A)

주식표 변경(상승, 하락 글꼴변경, 주요 금액단위 변경)

당근쨈 2017. 5. 7. 21:56


http://cafe.naver.com/excelmaster/138821


외부에서 긁어온 주식 정보의 서식을 변경하는 질문입니다.

1. 상승과 하락 글자를 화살표로 바꾸고 색깔 지정

2. 주요 금액의 단위를 변경


Select Case 문으로 상승과 하락의 글자를 기호로 바꿔주었고

금액의 주요단위를 변경하는 것은 미리 짜둔 코드를 이용하였습니다. - http://dorobo.tistory.com/356


사용자정의함수를 이용한 것 말고는 특별한 것이 없는 코드입니다만

주식 하시는 분들은 서식 변경할 때 사용하시면 좋을 듯 합니다.

Sub Macro()
 
    Dim SingleRange As Range
    Dim AllStock As Range
    
    Set AllStock = Range("C2", Cells(Rows.Count, 5).End(3))
    
    For Each SingleRange In AllStock
        
        With SingleRange
            
            Select Case .Column
            
                Case 3
                    Select Case Left(.Value2, 2)
                        Case "상승"
                            .Value2 = Replace(.Value2, "상승""▲")
                            .Font.Color = vbRed
                            
                        Case "하락"
                            .Value2 = Replace(.Value2, "하락""▼")
                            .Font.Color = vbBlue
                    End Select
                    
                Case 4
                    .Value2 = WorksheetFunction.Round(.Value2, -2)
                    .Value2 = Replace(.Value2, Right(.Value2, 2), "억")
                    
                Case 5
                    .Value2 = ToHan(.Value2 & "00000000")
                    
            End Select
        End With
        
    Next SingleRange
    
End Sub
 
Function ToHan(str As StringAs String
 
    Dim Dan As Variant
    Dim i As Integer
    
    Dan = Array("만""억""조")   '조까지 처리합니다. 경이나 해도 추가하면 됩니다.
    str = Format(str, "0")  '숫자가 커질 때 11E+17 처럼 변하면 아라비아숫자로 변환
    
    With CreateObject("VBScript.RegExp")    '졍규식 선언
    
        .Global = True  '셀 내 모든 글자
        .Pattern = "^(-?\d+)(\d{4})"    '마이너스를 포함한 숫자와 뒤에서부터 네개의 숫자를 그룹으로
        
        If .test(str) Then  '패턴이 일치하는 항목이 있을 때 작업
            
            On Error GoTo j '에러가 날 때까지 단위 변환
                Do          '처리하지 못하는 큰 숫자가 있을 때 숫자를 보전하기 위함
                
                    str = .Replace(str, "$1" & Dan(i) & "$2")
                    i = i + 1
                
                Loop
j:
            On Error GoTo 0
        
            .Pattern = "0000\D*"    '0000억 0000만을 없앰
            str = .Replace(str, "")
                        
            .Pattern = "(\D)0+" '10만0001, 3만0200 과 같을 때 10만1, 3만200 으로 변환
            str = .Replace(str, "$1")
                        
            .Pattern = "000"    '끝자리 000으로 남으면 천으로 변환
            str = .Replace(str, "천")
            
        End If
    End With
    
    ToHan = str
    
End Function
 
 
cs

noname.xlsm