none
기존 VBA 수정 문의 RRS feed

  • 질문

  • 안녕하세요


    http://support.microsoft.com/kb/210586를 참고하여

    엑셀에서 입력된 아라비아 숫자를 영문으로 변환해 사용중 입니다만

    여기서 일의 자리와 소수점 사이 'AND'를 'AND CENTS'로 변경 할 수 있을까요?

    (예) 현재는 =ConvertCurrencyToEnglish(10.20) 입력시 TEN AND TWENTY로 변환

    (요청)  TEN AND CENTS TWENTY로 바꾸고 싶습니다.

    너무 쉬운 질문을 해서 죄송합니다..

    2016년 11월 22일 화요일 오전 5:22

답변

  • 안녕하세요.

    말씀하신 변환 결과가 아래와 같은지 부터 한번 확인해보세요.

    s = ConvertCurrencyToEnglish(10.2)

     -> Ten And Cents Twenty

    s = ConvertCurrencyToEnglish(100.1)

     -> One Hundred And Cents Ten

    s = ConvertCurrencyToEnglish(10)

     -> Ten And No Cents

    위의 결과가 맞다면, 아래의 소스가 말씀하신대로 변환한 결과가 되겠습니다.

    Function ConvertCurrencyToEnglish(ByVal MyNumber)
       Dim Temp
       Dim Dollars, Cents
       Dim DecimalPlace, Count
    
       ReDim Place(9) As String
       Place(2) = " Thousand "
       Place(3) = " Million "
       Place(4) = " Billion "
       Place(5) = " Trillion "
    
       ' Convert MyNumber to a string, trimming extra spaces.
       MyNumber = Trim(Str(MyNumber))
    
       ' Find decimal place.
       DecimalPlace = InStr(MyNumber, ".")
    
       ' If we find decimal place...
       If DecimalPlace > 0 Then
          ' Convert cents
          Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
          Cents = ConvertTens(Temp)
    
          ' Strip off cents from remainder to convert.
          MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
       End If
    
       Count = 1
       Do While MyNumber <> ""
          ' Convert last 3 digits of MyNumber to English dollars.
          Temp = ConvertHundreds(Right(MyNumber, 3))
          If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
          If Len(MyNumber) > 3 Then
             ' Remove last 3 converted digits from MyNumber.
             MyNumber = Left(MyNumber, Len(MyNumber) - 3)
          Else
             MyNumber = ""
          End If
          Count = Count + 1
       Loop
    
       ' Clean up dollars.
       'Select Case Dollars
       '   Case ""
       '      Dollars = "No Dollars"
       '   Case "One"
       '      Dollars = "One Dollar"
       '   Case Else
       '      Dollars = Dollars & " Dollars"
       'End Select
    
       ' Clean up cents.
       Select Case Cents
          Case ""
             Cents = " And No Cents"
          Case "One"
             Cents = " And One Cent"
          Case Else
             Cents = " And " & "Cents " & Cents
       End Select
    
       ConvertCurrencyToEnglish = Dollars & Cents
    End Function
    
    Private Function ConvertHundreds(ByVal MyNumber)
       Dim Result As String
    
       ' Exit if there is nothing to convert.
       If Val(MyNumber) = 0 Then Exit Function
    
       ' Append leading zeros to number.
       MyNumber = Right("000" & MyNumber, 3)
    
       ' Do we have a hundreds place digit to convert?
       If Left(MyNumber, 1) <> "0" Then
          Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred "
       End If
    
       ' Do we have a tens place digit to convert?
       If Mid(MyNumber, 2, 1) <> "0" Then
          Result = Result & ConvertTens(Mid(MyNumber, 2))
       Else
          ' If not, then convert the ones place digit.
          Result = Result & ConvertDigit(Mid(MyNumber, 3))
       End If
    
       ConvertHundreds = Trim(Result)
    End Function
    
    Private Function ConvertTens(ByVal MyTens)
       Dim Result As String
    
       ' Is value between 10 and 19?
       If Val(Left(MyTens, 1)) = 1 Then
          Select Case Val(MyTens)
             Case 10: Result = "Ten"
             Case 11: Result = "Eleven"
             Case 12: Result = "Twelve"
             Case 13: Result = "Thirteen"
             Case 14: Result = "Fourteen"
             Case 15: Result = "Fifteen"
             Case 16: Result = "Sixteen"
             Case 17: Result = "Seventeen"
             Case 18: Result = "Eighteen"
             Case 19: Result = "Nineteen"
             Case Else
          End Select
       Else
          ' .. otherwise it's between 20 and 99.
          Select Case Val(Left(MyTens, 1))
             Case 2: Result = "Twenty "
             Case 3: Result = "Thirty "
             Case 4: Result = "Forty "
             Case 5: Result = "Fifty "
             Case 6: Result = "Sixty "
             Case 7: Result = "Seventy "
             Case 8: Result = "Eighty "
             Case 9: Result = "Ninety "
             Case Else
          End Select
    
          ' Convert ones place digit.
          Result = Result & ConvertDigit(Right(MyTens, 1))
       End If
    
       ConvertTens = Result
    End Function
    
    Private Function ConvertDigit(ByVal MyDigit)
       Select Case Val(MyDigit)
          Case 1: ConvertDigit = "One"
          Case 2: ConvertDigit = "Two"
          Case 3: ConvertDigit = "Three"
          Case 4: ConvertDigit = "Four"
          Case 5: ConvertDigit = "Five"
          Case 6: ConvertDigit = "Six"
          Case 7: ConvertDigit = "Seven"
          Case 8: ConvertDigit = "Eight"
          Case 9: ConvertDigit = "Nine"
          Case Else: ConvertDigit = ""
       End Select
    End Function


    프로그램 개발에는 정답이 없다.

    • 답변으로 표시됨 최Young 2016년 11월 24일 목요일 오전 6:13
    2016년 11월 24일 목요일 오전 12:27

모든 응답

  • 안녕하세요.

    말씀하신 변환 결과가 아래와 같은지 부터 한번 확인해보세요.

    s = ConvertCurrencyToEnglish(10.2)

     -> Ten And Cents Twenty

    s = ConvertCurrencyToEnglish(100.1)

     -> One Hundred And Cents Ten

    s = ConvertCurrencyToEnglish(10)

     -> Ten And No Cents

    위의 결과가 맞다면, 아래의 소스가 말씀하신대로 변환한 결과가 되겠습니다.

    Function ConvertCurrencyToEnglish(ByVal MyNumber)
       Dim Temp
       Dim Dollars, Cents
       Dim DecimalPlace, Count
    
       ReDim Place(9) As String
       Place(2) = " Thousand "
       Place(3) = " Million "
       Place(4) = " Billion "
       Place(5) = " Trillion "
    
       ' Convert MyNumber to a string, trimming extra spaces.
       MyNumber = Trim(Str(MyNumber))
    
       ' Find decimal place.
       DecimalPlace = InStr(MyNumber, ".")
    
       ' If we find decimal place...
       If DecimalPlace > 0 Then
          ' Convert cents
          Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
          Cents = ConvertTens(Temp)
    
          ' Strip off cents from remainder to convert.
          MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
       End If
    
       Count = 1
       Do While MyNumber <> ""
          ' Convert last 3 digits of MyNumber to English dollars.
          Temp = ConvertHundreds(Right(MyNumber, 3))
          If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
          If Len(MyNumber) > 3 Then
             ' Remove last 3 converted digits from MyNumber.
             MyNumber = Left(MyNumber, Len(MyNumber) - 3)
          Else
             MyNumber = ""
          End If
          Count = Count + 1
       Loop
    
       ' Clean up dollars.
       'Select Case Dollars
       '   Case ""
       '      Dollars = "No Dollars"
       '   Case "One"
       '      Dollars = "One Dollar"
       '   Case Else
       '      Dollars = Dollars & " Dollars"
       'End Select
    
       ' Clean up cents.
       Select Case Cents
          Case ""
             Cents = " And No Cents"
          Case "One"
             Cents = " And One Cent"
          Case Else
             Cents = " And " & "Cents " & Cents
       End Select
    
       ConvertCurrencyToEnglish = Dollars & Cents
    End Function
    
    Private Function ConvertHundreds(ByVal MyNumber)
       Dim Result As String
    
       ' Exit if there is nothing to convert.
       If Val(MyNumber) = 0 Then Exit Function
    
       ' Append leading zeros to number.
       MyNumber = Right("000" & MyNumber, 3)
    
       ' Do we have a hundreds place digit to convert?
       If Left(MyNumber, 1) <> "0" Then
          Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred "
       End If
    
       ' Do we have a tens place digit to convert?
       If Mid(MyNumber, 2, 1) <> "0" Then
          Result = Result & ConvertTens(Mid(MyNumber, 2))
       Else
          ' If not, then convert the ones place digit.
          Result = Result & ConvertDigit(Mid(MyNumber, 3))
       End If
    
       ConvertHundreds = Trim(Result)
    End Function
    
    Private Function ConvertTens(ByVal MyTens)
       Dim Result As String
    
       ' Is value between 10 and 19?
       If Val(Left(MyTens, 1)) = 1 Then
          Select Case Val(MyTens)
             Case 10: Result = "Ten"
             Case 11: Result = "Eleven"
             Case 12: Result = "Twelve"
             Case 13: Result = "Thirteen"
             Case 14: Result = "Fourteen"
             Case 15: Result = "Fifteen"
             Case 16: Result = "Sixteen"
             Case 17: Result = "Seventeen"
             Case 18: Result = "Eighteen"
             Case 19: Result = "Nineteen"
             Case Else
          End Select
       Else
          ' .. otherwise it's between 20 and 99.
          Select Case Val(Left(MyTens, 1))
             Case 2: Result = "Twenty "
             Case 3: Result = "Thirty "
             Case 4: Result = "Forty "
             Case 5: Result = "Fifty "
             Case 6: Result = "Sixty "
             Case 7: Result = "Seventy "
             Case 8: Result = "Eighty "
             Case 9: Result = "Ninety "
             Case Else
          End Select
    
          ' Convert ones place digit.
          Result = Result & ConvertDigit(Right(MyTens, 1))
       End If
    
       ConvertTens = Result
    End Function
    
    Private Function ConvertDigit(ByVal MyDigit)
       Select Case Val(MyDigit)
          Case 1: ConvertDigit = "One"
          Case 2: ConvertDigit = "Two"
          Case 3: ConvertDigit = "Three"
          Case 4: ConvertDigit = "Four"
          Case 5: ConvertDigit = "Five"
          Case 6: ConvertDigit = "Six"
          Case 7: ConvertDigit = "Seven"
          Case 8: ConvertDigit = "Eight"
          Case 9: ConvertDigit = "Nine"
          Case Else: ConvertDigit = ""
       End Select
    End Function


    프로그램 개발에는 정답이 없다.

    • 답변으로 표시됨 최Young 2016년 11월 24일 목요일 오전 6:13
    2016년 11월 24일 목요일 오전 12:27
  • 안녕하세요! 예 딱 맞는 결과가 나옵니다. 어느부분이 바뀐건지 미묘합니다. 감사합니다!
    • 편집됨 최Young 2016년 11월 24일 목요일 오전 6:28
    2016년 11월 24일 목요일 오전 6:27