为一系列列一次一列运行相同的 VBA 代码

如何解决为一系列列一次一列运行相同的 VBA 代码

我有一个日期范围，每个月我需要将这些日期转换为 'MM/DD/YYYY 格式（但作为文本）。

我曾经使用这个公式 =TEXT(Cell Ref.,"MM/DD/YYYY") 手动转换这些。见上图。我最近开始使用下面的 VBA 代码来节省我的时间（每个月大约有 18 列有 20 万行数据）。

Sub MM_DD_YYYY()
Application.ScreenUpdating = False
Dim rng As Range

Selection.NumberFormat = "0"

For Each rng In Selection
rng.Value = "+text(" & rng.Value & ",""MM/DD/YYYY"")"
Next rng

    Selection.TextToColumns DataType:=xlDelimited,_
        TextQualifier:=xlDoubleQuote,ConsecutiveDelimiter:=False,Tab:=True,_
        Semicolon:=False,Comma:=False,Space:=False,Other:=False,FieldInfo _
        :=Array(1,1),TrailingMinusNumbers:=True

    Selection.copy
    Selection.PasteSpecial Paste:=xlPasteValues,Operation:=xlNone,SkipBlanks _
        :=False,Transpose:=False
    Application.CutcopyMode = False

Application.ScreenUpdating = True
End Sub

如果我选择一列，此代码工作正常，但如果我选择多列，则失败，因为它具有文本到列元素（显然一次仅适用于一列）。是否可以在选择整个范围后一次运行一列代码而不破坏它？

顺便说一下，我尝试了以下文本到列的替代方法：

模拟 F2+Enter。这有效，但需要很多时间。

For Each rng In Selection
    SendKeys "{F2}",True
    SendKeys "{ENTER}",True
Next

由于某种原因不起作用。

Selection.Value = Selection.FormulaR1C1

由于某种原因不起作用。

For Each rng In Selection
Selection.Value = Selection.Value
Next rng

非常感谢您的帮助或建议。谢谢。

解决方法

输出在开头有一个撇号，即它是一个文本。这就是我使用文本公式的原因。 Selection.NumberFormat = "MM/DD/YYYY" 也不起作用。日期范围是实际日期，但输出应该是文本。 – ram singh 12 秒前

试试这个。解释见Convert an entire range to uppercase without looping through all the cells。以下代码使用 INDEX() 和 TEXT()。

Option Explicit

Sub Sample()
    Dim rng As Range
    Dim sAddr As String

    Set rng = Range("A1:C5") '<~~ Change this to relevant range
    sAddr = rng.Address

    rng = Evaluate("index(""'"" & Text(" & sAddr & ",""MM/DD/YYYY""),)")
End Sub

之前：

之后：

编辑

@SiddharthRout 只是好奇，是否有可能使其适用于多个范围。例如，我在 Col A 和 Col C 中有日期（Col B 有一些其他数据）。当前代码不起作用，因为如果我只选择 Col A 和 Col C，它们现在是 2 个范围。有什么想法吗？ – 拉姆辛格 15 分钟前

这是你想要的吗？

Option Explicit

Sub Sample()
    Dim rng As Range
    Dim ar As Range
    Dim sAddr As String

    Set rng = Range("A1:A5,C1:C5") '<~~ Sample range
    
    For Each ar In rng.Areas
        sAddr = ar.Address

        ar = Evaluate("index(""'"" & Text(" & sAddr & ",)")
    Next ar
End Sub

之前：

之后：