VBA Excel: 防止 Excel 在将所有单元格更改为大写后将数据更改为日期

VBA Excel: Prevent Excel to change data as date after changing all cells to uppercase

我有以下代码来将两个指定范围内的所有数据大写,然后 运行 一些比较代码。 问题是一旦 运行s 包含类似 1-2 的大写代码单元格更改为 2-Jan。我不能将 .NumberFormat = "@" 应用到整个作品 sheet 或那个特定的列,因为我正在使 sheet 动态化并且这些数据不会总是在同一列中。有人知道如何解决这个问题吗?

Dim rangeToUse As Range, singleArea As Range, cell1 As Range, cell2 As Range, rng As Range, rng2 As Range
Dim I As Integer, J As Integer

'Set two range selections
Set rng = Application.InputBox("Select First Range", "Obtain 1st Range Object", Type:=8)
Set rng2 = Application.InputBox("Select Second Range", "Obtain 2nd Range Object", Type:=8)
Set MultiRange = Union(rng, rng2)
MultiRange.Select

Set rangeToUse = Selection
Cells.Interior.ColorIndex = 0
Cells.Borders.LineStyle = xlNone

'Capitalizes all cells in selected range
'Turn off screen updating to increase performance
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'Worksheets("Phase 3 xwire").Range(rangeToUse).NumberFormat = "@"

   'Convert all constants and text values to proper case
   For Each LCell In Cells.SpecialCells(xlConstants, xlTextValues)
      LCell.Formula = UCase(LCell.Formula)
      Calculate
   Next

If Selection.Areas.Count <= 1 Then
      MsgBox "Please select more than one area."
    Else
        rangeToUse.Interior.ColorIndex = 0
        For Each singleArea In rangeToUse.Areas
            singleArea.BorderAround ColorIndex:=1, Weight:=xlMedium
        Next singleArea
        'Areas.count - 1 will avoid trying to compare
        ' Area(count) to the non-existent area(count+1)
        For I = 1 To rangeToUse.Areas.Count - 1
            For Each cell1 In rangeToUse.Areas(I)
                'I+1 gets you the NEXT area
                Set cell2 = rangeToUse.Areas(I + 1).Cells(cell1.Row - 1, cell1.Column - 1)
                 If IsEmpty(cell2.Value) Then
                 GoTo Done
                 Else
                    If cell1.Value <> cell2.Value Then
                        cell1.Interior.ColorIndex = 38
                        cell2.Interior.ColorIndex = 38
                    End If
                 End If
            Next cell1
        Next I
Done:
End If
'Turn screen updating back on
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

如果您保留输入框,您可以在 MultiRange.Select 命令后添加这行代码

Selection.NumberFormat = "@"