Excel. Форматирование угловых градусных величин в D.D, DM.M, DMS.S: различия между версиями

Материал из GIS-Lab
Перейти к навигации Перейти к поиску
Нет описания правки
Нет описания правки
 
(не показано 12 промежуточных версий этого же участника)
Строка 12: Строка 12:
* возможность совершения математических операций со значениями функции.<br/>
* возможность совершения математических операций со значениями функции.<br/>
===Текущие недостатки===
===Текущие недостатки===
* в системе должен быть установлен разделитель дробной части «.»;<br/>
* проблемы округления VBA (если принципиально, точность задавать на порядок выше, чем требуется).<br/>
* проблемы округления VBA (если принципиально, точность задавать на порядок выше, чем требуется).<br/>
==Описание функции==
==Описание функции==
Строка 27: Строка 26:
===Описание исходных данных===
===Описание исходных данных===
Исходные данные могут быть представлены любой адекватной комбинацией символов (пожалуй, единственное требование чтобы разделитель дробной части («.» или «,») был в единственном экземпляре):<br/>
Исходные данные могут быть представлены любой адекватной комбинацией символов (пожалуй, единственное требование чтобы разделитель дробной части («.» или «,») был в единственном экземпляре):<br/>
:70.085531683083300<br/>
===Пример результата работы функции===
:70,085531675°<br/>
{| class="wikitable"
:10<br/>
|-
:70°59'59.995403"<br/>
!Исходные данные!!=DMS(по умолчанию)!!=DMS(Формат&Точность)!!Формат!!Точность
:70° 59' 59,995403"<br/>
|-
:70гр 30.5мин 1сек<br/>
|70.08553168||70°05'07.91"||70.08553168||0||10
:70 60.5' 1'<br/>
|-
:70- 30.5-1<br/>
|70,085531675°||70°05'07.91"||70°05.13'||2||2
:0d 30,5m<br/>
|-
|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
|}
<br/>
==Способы подключения функции==
==Способы подключения функции==
===Простой - для любого пользователя===
===Простой - для любого пользователя===
Добавить надстройку «DAD.xlam» в Excel.<br/>
Добавить надстройку [https://yadi.sk/d/KbM6sCVK3TibET «DAD.xlam»] в Excel.<br/>
Сделать это можно как через «Параметры Excel», так и скопировав в директорию аналогичную «c:\Users\Пользователь\AppData\Roaming\Microsoft\AddIns\».<br/>
Сделать это можно как через [https://e-xcel.ru/index.php/makrosy/kak-podklyuchat-nadstrojki-k-ms-excel «Параметры Excel»], так и скопировав в директорию аналогичную [http://macros-vba.ru/nadstrojki/excel/64-kak-ustanovit-nadstrojku-na-komputer «c:\Users\Пользователь\AppData\Roaming\Microsoft\AddIns\»].<br/>
ДАТЬ ССЫЛКИ НА СТАТЬИ В ИНЕТЕ.<br/>
После добавления и подключения надстройки в Excel, данная функция появится на ряду со встроенными.<br/>
После добавления и подключения надстройки в Excel, данная функция появится на ряду со встроенными.<br/>
===Интересный - для пользователя с лишним временем===
===Интересный - для пользователя с лишним временем===
Использовать код VBA (кто знает что это, знает как это).<br/>
Использовать код VBA (кто знает что это, знает как это).<br/>
В программировании не силен, в основном все решено логикой, поэтому если у специалистов будут оптимизации кода, просьба в т.ч. отправлять варианты своего кода на [mailto:DAD.spb@ya.ru DAD.spb@ya.ru].<br/>
<syntaxhighlight lang="vb">
<syntaxhighlight lang="vb">
ДОБАВИТЬ КОД.
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
</syntaxhighlight>
</syntaxhighlight>
<br/>
<br/>
Строка 51: Строка 130:
Подключение надстроек в Excel:<br/>
Подключение надстроек в Excel:<br/>
* [https://e-xcel.ru/index.php/makrosy/kak-podklyuchat-nadstrojki-k-ms-excel ЁXCEL.RU: Как подключать надстройки к MS Excel?]<br/>
* [https://e-xcel.ru/index.php/makrosy/kak-podklyuchat-nadstrojki-k-ms-excel ЁXCEL.RU: Как подключать надстройки к MS Excel?]<br/>
* [https://support.office.com/ru-ru/article/%D0%94%D0%BE%D0%B1%D0%B0%D0%B2%D0%BB%D0%B5%D0%BD%D0%B8%D0%B5-%D0%B8-%D1%83%D0%B4%D0%B0%D0%BB%D0%B5%D0%BD%D0%B8%D0%B5-%D0%BD%D0%B0%D0%B4%D1%81%D1%82%D1%80%D0%BE%D0%B5%D0%BA-%D0%B2-excel-0af570c4-5cf3-4fa9-9b88-403625a0b460 Support.Office.com: Добавление и удаление надстроек в Excel]<br/>
VBA в Excel:<br/>
VBA в Excel:<br/>
* [https://e-xcel.ru/index.php/makrosy/kak-vstavit-gotovyj-makros-v-rabochuyu-knigu ЁXCEL.RU: Как вставить готовый макрос в рабочую книгу?]<br/>
* [https://e-xcel.ru/index.php/makrosy/kak-vstavit-gotovyj-makros-v-rabochuyu-knigu ЁXCEL.RU: Как вставить готовый макрос в рабочую книгу?]<br/>
Строка 57: Строка 137:
* [https://support.office.com/ru-ru/article/%d0%a4%d0%be%d1%80%d0%bc%d1%83%d0%bb%d1%8b-%d0%b8-%d1%84%d1%83%d0%bd%d0%ba%d1%86%d0%b8%d0%b8-294d9486-b332-48ed-b489-abe7d0f9eda9?ui=ru-RU&rs=ru-RU&ad=RU#ID0EAABAAA=Reference Support.Office.com: Формулы и функции]<br/>
* [https://support.office.com/ru-ru/article/%d0%a4%d0%be%d1%80%d0%bc%d1%83%d0%bb%d1%8b-%d0%b8-%d1%84%d1%83%d0%bd%d0%ba%d1%86%d0%b8%d0%b8-294d9486-b332-48ed-b489-abe7d0f9eda9?ui=ru-RU&rs=ru-RU&ad=RU#ID0EAABAAA=Reference Support.Office.com: Формулы и функции]<br/>
Надстройка с функцией DMS():<br/>
Надстройка с функцией DMS():<br/>
* [https:// Яндекс Диск]<br/>
* [https://yadi.sk/d/KbM6sCVK3TibET Яндекс Диск]<br/>
* [https:// Облако Mail]<br/>
* [https:// Google Диск]<br/>

Текущая версия от 19:22, 24 марта 2018

Эта страница является черновиком статьи.


Описание варианта форматирования угловых градусных величин с помощью 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:

VBA в Excel:

Функции в Excel:

Надстройка с функцией DMS():