VBA Excel 填充公式与外部 function 向下直到最后一行

Question

I am using the function located here:

https://www.extendoffice.com/documents/excel/1497-excel-convert-decimal-degrees-to-degrees-minutes-seconds.html

in order to convert the degree min sec values to the decimal ones.

Unfortunately, I've encountered the problem.

I found that is not so simple as shown in this example:

Fill formula down till last row in column

in the other hand, the example more dedicated for my situation

Finding the Last Row and using it in a formula

also wans't successful.

I would like to know why I am getting:

• the result to the second row only
• the "@" character before by formula (as I can see in the bar).

What is wrong with my code then?

 Sub Sun()
 Dim rng As Range, cell As Range
 Dim wors As Worksheet

 Set wors = ThisWorkbook.ActiveSheet

 Dim lastRow As Long, LastRow2 As Long

 lastRow = wors.Range("P" & wors.Rows.Count).End(xlUp).Row
 LastRow2 = wors.Range("Q" & wors.Rows.Count).End(xlUp).Row
 Set rng = wors.Range("P1:P" & lastRow)



 wors.Columns("E").Copy
 wors.Columns("P").PasteSpecial xlPasteValues



 For Each cell In rng
 cell = WorksheetFunction.Substitute(cell, " ", "° ", 1)
 Next

 Call Degree

 Range("Q2:Q" & lastRow).Formula = "=ConvertDecimal (P" & LastRow2 & " )"

 End Sub

Moreover, it comes to an error:

Invalid procedure call or argument

, with debugging:

     xDeg = Val(Left(pInput, InStr(1, pInput, "°") - 1))  

the code from the function:

 Function ConvertDecimal(pInput As String) As Double
'Updateby20140227
 Dim xDeg As Double
 Dim xMin As Double
 Dim xSec As Double
 xDeg = Val(Left(pInput, InStr(1, pInput, "°") - 1))
 xMin = Val(Mid(pInput, InStr(1, pInput, "°") + 2, _
         InStr(1, pInput, "'") - InStr(1, pInput, _
         "°") - 2)) / 60
 xSec = Val(Mid(pInput, InStr(1, pInput, "'") + _
        2, Len(pInput) - InStr(1, pInput, "'") - 2)) _
        / 3600
 ConvertDecimal = xDeg + xMin + xSec
 End Function

How can I drag this formula down to the last row?

Answer 1

Your order is a little off, fill P before trying to find the last row.

Also finding the last row in Q is not needed.

 Sub Sun()
     Dim rng As Range, cell As Range
     Dim wors As Worksheet
    
     Set wors = ThisWorkbook.ActiveSheet
    
     Dim lastRow As Long
     
     wors.Columns("E").Copy
     wors.Columns("P").PasteSpecial xlPasteValues
    
     lastRow = wors.Range("P" & wors.Rows.Count).End(xlUp).Row
     Set rng = wors.Range("P1:P" & lastRow)
     For Each cell In rng
         cell = WorksheetFunction.Substitute(cell, " ", "° ", 1)
         cell = WorksheetFunction.Substitute(cell, " ", "' ", 2)
     Next
    
   
     Range("Q2:Q" & lastRow).Formula2 = "=ConvertDecimal(P2)"

 End Sub

But I would use variant arrays to speed it up a little:

 Sub Sun()
     Dim rng As Variant, cell As Range
     Dim wors As Worksheet
    
     Set wors = ThisWorkbook.ActiveSheet
    
     Dim lastRow As Long
     
   
     lastRow = wors.Range("E" & wors.Rows.Count).End(xlUp).Row
     rng = wors.Range("E1:E" & lastRow).Value
     
     Dim outArray() As Variant
     ReDim outArray(1 To UBound(rng, 1), 1 To 2)
     
     outArray(1, 1) = rng(1, 1)
     outArray(1, 2) = "Output"
     
     Dim i As Long
     For i = 2 To UBound(rng, 1)
        rng(i, 1) = WorksheetFunction.Substitute(WorksheetFunction.Substitute(rng(i, 1), " ", "' ", 2), " ", "° ", 1)
        outArray(i, 1) = rng(i, 1)
        outArray(i, 2) = ConvertDecimal(CStr(rng(i, 1)))

     Next
    
     wors.Range("P1").Resize(UBound(outArray, 1), 2).Value = outArray

 End Sub