vba - 无需复制/粘贴即可执行单元格值修改 - VBA

Question

所以我有一个连接源，它从 URL 导入 XML 文件。 XML 包含一些格式为 mm/dd/yy 的日期，但是 Excel 似乎无法判断它是 20xx，而是要求我在每次刷新后指定它是 19xx 还是 20xx数据(数据每天更新)。

所以我制作了一个脚本，使用复制/粘贴来解决这个问题。问题是它很慢并且不能在后台完成。如果我在另一个工作表上运行脚本，它会很快开始更改工作表并卡住几秒钟。下面是我的代码:

Sub test()

Dim listCols As ListColumns
Set listCols = Sheets("RawData").ListObjects("RawTable").ListColumns

'Sets the very last row & column to 0, to be copied later
Range("XFD1048576").Value = "0"

For col = 1 To listCols.Count 'Iterate through columns in table
    If listCols(col) = "DATECOL1" Or listCols(col) = "DATECOL2" Or listCols(col) = "DATECOL3" _
    Or listCols(col) = "DATECOL4" Or listCols(col) = "DATECOL5" Or listCols(col) = "RESERVATIONEND" Then

        For Each cell In listCols(col).DataBodyRange.Cells
            If cell.Value <> "" Then 'ignore empty cells
                'Copies the very last column & row
                With Range("XFD1048576")
                    .Copy
                End With
                'Pastes the '0' value from above and adds it to the original value in the cell it is pasting in
                With cell
                    .PasteSpecial xlPasteValues, xlPasteSpecialOperationAdd
                    .NumberFormat = "mm/dd/yy"
                End With
                Application.CutCopyMode = False
            End If
        Next
    End If
Next

Range("XFD1048576").ClearContents 'Clear the '0' in there

End Sub

任何帮助表示赞赏。

编辑:



编辑2:
我不确定它是什么，但使用 .value = .value 肯定有效。我使用如下所示的简单代码对其进行了测试:

Sub test3()
With Range("W1:W59")
    .Value = .Value
    .NumberFormat = "mm/dd/yy"
End With
End Sub

Answer 1

她是您代码的更高效版本。它避免了复制/粘贴操作，以及通过单元格的循环

Sub Demo()
    Dim listCols As ListColumns
    Dim col As Long
    Dim cell As Range

    Set listCols = Sheets("RawData").ListObjects("RawTable").ListColumns

    FormatDates listCols("DATECOL1")
    FormatDates listCols("DATECOL2")
    FormatDates listCols("DATECOL3")
    FormatDates listCols("DATECOL4")
    FormatDates listCols("DATECOL5")
    FormatDates listCols("RESERVATIONEND")
End Sub

Private Sub FormatDates(ListCol As ListColumn)
    Dim rng As Range, arr As Range
    On Error Resume Next
    Set rng = ListCol.DataBodyRange.SpecialCells(xlCellTypeConstants)
    On Error GoTo 0
    If Not rng Is Nothing Then
        For Each arr In rng.Areas
            With arr
                .NumberFormat = "mm/dd/yy"
                .Value = .Value
            End With
        Next
    End If
End Sub