VBA Excel: Предотвратить Excel для изменения данных как даты после смены всех ячеек на верхний регистр

Question

У меня есть следующий код, чтобы использовать все данные в двух указанных диапазонах, а затем запустить некоторый код сравнения. Проблема заключается в том, что она запускает ячейки кода с заглавными буквами, которые содержат что-то вроде 1-2, получает изменение на 2-Jan. Я не могу применить .NumberFormat = "@" ко всему листу или к определенному столбцу, потому что я делаю динамический лист, и эти данные не всегда будут в одном столбце. Кто-нибудь знает, как позаботиться об этой проблеме?

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 

Answer 1

Если вы оставляете поля ввода можно добавить следующую строку кода после команды MultiRange.Select

Selection.NumberFormat = "@"