使用输入框方法引用公式

Question

我想通过 excel VBA 应用 Text(E2,"MM/DD/YYYY") 公式。我使用多张纸，单元格目标和单元格引用不固定。因此，我使用输入框方法来输入完美的单元格目标，并希望通过输入框方法手动选择或更改公式中的单元格引用。 例如。如果我在 A2 单元格中写上面的公式，我的目标单元格是 E2。单元格选择应通过输入框进行。

最初我的计划是用输入框选择这两个东西，但我只是一个初学者并没有设法做到这一点，因此改变了计划并重新编写了代码。但是在输入框中编辑公式范围时代码似乎存在一些问题，有时它不考虑我的输入。如果我说 Text(E2,"MM/DD/YYYY") 然后它选择 Text(D2 or something,"MM/DD/YYYY")

Option Explicit

Sub FinalTxtDte()

Dim Rng As range
Dim LastRow As Long
Dim Frmla As String
Dim DestRng As range

On Error Resume Next ' if the user presses "Cancel"

Set Rng = Application.InputBox("Select a Cell which needs to be converted in Date format.", "Range Selection", Type:=8)

Err.Clear

On Error GoTo 0

If Not Rng Is Nothing Then

    Frmla = "=TEXT(" & Rng.Address("False", "False") & ",""MM/DD/YYYY"")"

    On Error Resume Next ' if the user presses "Cancel"

    Set DestRng = Application.InputBox("Select a Cell where you would like to get a Converted Date.", "Range Selection", Type:=8)

    Err.Clear

    On Error GoTo 0

    If Not DestRng Is Nothing Then

        DestRng.Formula = Frmla

    LastRow = Rng.End(xlDown).Row
    DestRng.Select
    range(Selection, Selection.Offset(LastRow - Rng.Row, 0)).Select
    Selection.FillDown
    range(Selection, Selection.Offset(LastRow - Rng.Row, 0)).Value _
    = range(Selection, Selection.Offset(LastRow - Rng.Row, 0)).Value

    End If

    End If

End Sub

Answer 1

下面的代码将让您使用 2 InputBoxes 来选择单元格和公式目标（目前根据您的 post requaet 它适用于 1 个单元格）。

我修改了第二个InputBox 以选择公式的目标范围。

您需要保留On Error Resume Next（以及后来的On Error GoTo 0），以防用户在输入框中选择"Cancel" 选项。

代码

Option Explicit

Sub TextDateFormula()

Dim Rng As Range
Dim LastRow As Long
Dim Frmla As String, Txt As String
Dim DestRng As Range

On Error Resume Next ' if the user presses "Cancel"
Set Rng = Application.InputBox("Select a cell.", "Range Selection", Type:=8)
Err.Clear
On Error GoTo 0

If Not Rng Is Nothing Then    
    Frmla = "=TEXT(" & Rng.Address(True, True) & ",""MM/DD/YYYY"")"

    On Error Resume Next ' if the user presses "Cancel"
    Set DestRng = Application.InputBox("Select a range to add Decimal Hours.", "Range Selection", Type:=8)
    Err.Clear
    On Error GoTo 0

    If Not DestRng Is Nothing Then
        DestRng.Formula = Frmla
    End If        
End If

End Sub

---

编辑1：为了使公式不取绝对地址，修改下面的代码行：

Frmla = "=TEXT(" & rng.Address(False, False) & ",""MM/DD/YYYY"")"

Address("Row Absolute", "Column Absolute")后面的括号里面的部分需要修改，所以根据需要修改列和行设置。