업무용

[엑셀] 셀에 있는 숫자에 직접 곱셈, 나눗셈, 덧셈, 뺄샘 하기 - VBA사용

아저씨아저씨아저아저 2020. 11. 2. 14:55
반응형

 

 

간혹 엑셀 작성하다 보면 해당 셀에 있는 숫자에 천 단위로 보이기 위해 곱셈을 하거나

혹은 환율적용을 위해 일괄적으로 특정 숫자를 나누거나 하는일이 다반사...

 

이럴때 옆에 셀에다가

 

=셀주소*1000

 

와 같이 하고 또 복사하고.. 이러기엔 너무 시간이 많이 걸려서 단축키로 한번에 해결하기위해 구글링을 하여 작성!!

 

단축키 지정하면 아래 처럼 나타나고 해당 셀에 바로 적용 가능함

 

대표사진 삭제

사진 설명을 입력하세요.

 

 

 

Private Sub Calculate()

'단축키 알아서 지정

'숫자 더하기, 빼기, 나누기, 곱하기 연산 수행

Dim rngConstant As Range, rngEacharea As Range

Dim varQues

On Error GoTo Err_Step

Set rngUndo = Intersect(Selection, Selection.SpecialCells(xlCellTypeVisible))

If rngUndo.Areas.Count = 1 Then

varUndo = rngUndo.Formula

End If

Set rngConstant = Intersect(rngUndo, _

Selection.SpecialCells(xlCellTypeConstants, 5))

varQues = InputBox("연산하고 싶은 기호 및 숫자를 입력하세요.", Default:="*1000")

If varQues = vbNullString Then Exit Sub

If varQues Like "[/,*]0" Then

MsgBox "0을 곱하거나 나누기하면 오류가....", vbInformation

Exit Sub

End If

For Each rngEacharea In rngConstant.Areas

rngEacharea = Application.Evaluate(rngEacharea.Address & varQues)

Next rngEacharea

If rngUndo.Areas.Count = 1 Then

Application.OnUndo "연산 취소", "Action_Undo"

End If

Err_Step:

If Err.Number = 1004 Then

MsgBox "범위에 숫자가 없습니다.", vbInformation

End If

Application.OnRepeat "", ""

End Sub

 

반응형