带有外部函数的VBA Excel填充公式一直到最后一行

Question

我正在使用位于此处的函数：

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

为了将度分秒值转换为小数。

很遗憾，我遇到了这个问题。

我发现没有这个例子那么简单：

Fill formula down till last row in column

另一方面，这个例子更适合我的情况

Finding the Last Row and using it in a formula

也不想成功。

我想知道我为什么会得到：

• 只显示第二行的结果
• 公式前面的“@”字符（我可以在栏中看到）。

那我的代码有什么问题？

 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

而且还报错：

无效的过程调用或参数

，带调试：

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

函数代码：

 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

如何将此公式拖到最后一行？

Answer 1

您的订单有点偏，请在尝试找到最后一行之前填写 P。

也不需要找到 Q 中的最后一行。

 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

但我会使用变体数组来加快速度：

 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