Question

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

最初我的计划是用输入框选择两个东西，但我只是一个初学者而没有设法做到这一点因此改变了计划并重新编写了代码。但是在输入框中编辑公式范围时，代码似乎存在一些问题，有时它不考虑我的输入。如果我说文本(E2,"MM/DD/YYYY")然后它选择文本（D2或其他，“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 InputBox es来选择单元格和公式目标（目前根据您的帖子需要1个单元格）。

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

如果用户在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")之后修改括号内的部分，因此请根据需要修改列和行设置。

使用inputbox方法参考公式

1 个答案: