Excel. Форматирование угловых градусных величин в D.D, DM.M, DMS.S
Описание варианта форматирования угловых градусных величин с помощью Excel
(Г.Г°, Г°М.М', Г°М'С.С" туда и обратно).
Введение
Исходные данные угловых градусных величин отличаются избыточным многообразием в зависимости от формата величины, точности, вкуса оформления исполнителя и т.п. При большом объеме данных любая автоматизация приведения этих данных к требуемому формату может потребовать времени и некоторой наблюдательности. Функция Excel DMS() упрощает этот процесс.
Достоинства и недостатки функции
Достоинства
- удобство выбора точности представления данных;
- представление целочисленных данных (минут и секунд) в формате «00»;
- корректное округление минут и секунд, итоговый диапазон «00-59»;
- приличная «всеядность» исходных данных;
- возможность совершения математических операций со значениями функции.
Текущие недостатки
- проблемы округления VBA (если принципиально, точность задавать на порядок выше, чем требуется).
Описание функции
Синтаксис функции
В ячейку функция вставляется в виде формулы: =DMS(ячейка;формат;точность;разделитель)
- имя - DMS;
- аргументы (могут быть введены непосредственно в формулу или указаны через ссылки на ячейки):
- «ячейка» - ссылка на ячейку со значением (обязательный);
- «формат» - «1», «2», «3» - Г.Г, ГМ.М, ГМС.С соответственно, «0» - числовое значение (необязательный, по умолчанию «3»);
- «точность» - точность округления (необязательный, по умолчанию для Г.Г, ГМ.М, ГМС.С – «6», «4», «2» соответственно);
- «разделитель» - символ, заменяющий «°», «'», «"» (необязательный, но иногда нужны « », «;» и т.п.).
- «ячейка» - ссылка на ячейку со значением (обязательный);
Описание работы функции
Функция преобразует значение, представляющее величину угла, в число с двойной точностью вещественного типа и потом форматирует это число в виде, указанном аргументами функций (если задан «формат»=«0», количество знаков задается в т.ч. форматом ячейки).
Описание исходных данных
Исходные данные могут быть представлены любой адекватной комбинацией символов (пожалуй, единственное требование чтобы разделитель дробной части («.» или «,») был в единственном экземпляре):
Пример результата работы функции
| Исходные данные | =DMS(по умолчанию) | =DMS(Формат&Точность) | Формат | Точность |
|---|---|---|---|---|
| 70.08553168 | 70°05'07.91" | 70.08553168 | 0 | 10 |
| 70,085531675° | 70°05'07.91" | 70°05.13' | 2 | 2 |
| 10 | 10°00'00.00" | 10°00.00' | 2 | 2 |
| 70°59'59.995403" | 71°00'00.00" | 70.9999987231° | 1 | 10 |
| 70° 59' 59,995403" | 71°00'00.00" | 70°59'59.995" | 3 | 3 |
| 70гр 30.5мин 1сек | 70°30'31.00" | 70°30.52' | 2 | 2 |
| 70 60.5' 1' | 71°00'31.00" | 71°00'31.000" | 3 | 3 |
| 70- 30.5-1 | 70°30'31.00" | 70°30'31.000" | 3 | 3 |
| 0d 30,5m | 00°30'30.00" | 00°30'30" | 3 | 0 |
Способы подключения функции
Простой - для любого пользователя
Добавить надстройку «DAD.xlam» в Excel.
Сделать это можно как через «Параметры Excel», так и скопировав в директорию аналогичную «c:\Users\Пользователь\AppData\Roaming\Microsoft\AddIns\».
После добавления и подключения надстройки в Excel, данная функция появится на ряду со встроенными.
Интересный - для пользователя с лишним временем
Использовать код VBA (кто знает что это, знает как это).
В программировании не силен, в основном все решено логикой, поэтому если у специалистов будут оптимизации кода, просьба в т.ч. отправлять варианты своего кода на DAD.spb@ya.ru.
Option Explicit
Dim I As Integer
Dim myRound As Integer
Dim DDD As Double
Dim myD As Double
Dim myM As Double
Dim myS As Double
Dim myX1 As Double
Dim myY1 As Double
Dim myX2 As Double
Dim myY2 As Double
Dim mySeparator As String
Dim sysSeparator As String
Dim mySpace As String
Dim myF As String
Dim myEntry As Variant
Dim myValue As Variant
Dim myDim() As String
Dim myReplace() As Variant
Public Function DMS(myValue, Optional myDMS As String = "3", Optional myR As String = "", Optional mySpace As String = "")
DDD = 0
mySeparator = Chr(47)
sysSeparator = Application.International(xlDecimalSeparator)
myValue = Trim(Replace(myValue, Chr(44), Chr(46)))
For I = 1 To Len(myValue)
If Asc(Mid(myValue, I, 1)) < 46 Or Asc(Mid(myValue, I, 1)) > 57 Then
Mid(myValue, I, 1) = mySeparator
End If
Next I
While InStr(myValue, mySeparator & mySeparator) > 0
myValue = Replace(myValue, mySeparator & mySeparator, mySeparator)
Wend
myValue = IIf(Right(myValue, 1) = mySeparator, Left(myValue, Len(myValue) - 1), myValue)
myDim = Split(myValue, mySeparator)
For I = 0 To UBound(myDim)
DDD = IIf(sysSeparator = Chr(44), DDD + Val(myDim(I)) / (60 ^ I), DDD + CDbl(myDim(I)) / (60 ^ I))
Next I
Select Case myDMS
Case "0"
myRound = IIf(myR = "", 6, Val(myR))
DMS = Round(DDD, myRound)
Case "1"
myRound = IIf(myR = "", 6, Val(myR))
myF = "00" & IIf(myRound = 0, "", Chr(46)) & String(myRound, "0")
DMS = Format(Round(DDD, myRound), myF) & IIf(mySpace = "", Chr(176), mySpace)
Case "2"
myRound = IIf(myR = "", 4, Val(myR))
myD = Int(DDD)
myM = Round((DDD - myD) * 60, myRound)
If myM = 60 Then myD = myD + 1: myM = 0
myF = "00" & IIf(myRound = 0, "", Chr(46)) & String(myRound, "0")
DMS = Format(myD, "00") & IIf(mySpace = "", Chr(176), mySpace) & Format(myM, myF) & IIf(mySpace = "", Chr(39), mySpace)
Case "3"
myRound = IIf(myR = "", 2, Val(myR))
myD = Int(DDD)
myM = Int((DDD - myD) * 60)
myS = Round((DDD - myD - myM / 60) * 3600, myRound)
If myS = 60 Then myM = myM + 1: myS = 0
If myM = 60 Then myD = myD + 1: myM = 0
myF = "00" & IIf(myRound = 0, "", Chr(46)) & String(myRound, "0")
DMS = Format(myD, "00") & IIf(mySpace = "", Chr(176), mySpace) & Format(myM, "00") & IIf(mySpace = "", Chr(39), mySpace) & Format(myS, myF) & IIf(mySpace = "", Chr(34), mySpace)
Case Else
DMS = "=(Ячейка;Формат;Точность;Разделитель)"
End Select
End Function
Ссылки по теме
Подключение надстроек в Excel:
- ЁXCEL.RU: Как подключать надстройки к MS Excel?
- Support.Office.com: Добавление и удаление надстроек в Excel
VBA в Excel:
Функции в Excel:
Надстройка с функцией DMS():