我有一个Excel 2010工作表，其中有宏将数据从其他工作表复制到另一个工作表的特定格式。
数据副本，但我有一个问题与单元格范围的格式保存日期或时间值。
数据来源于数据库摘录，所有内容都是文本格式。在我的工作表中，当我复制日期(通过VBA)时，我应用"yyyy-mm-dd"格式的日期和"hh:mm.ss.ss"的时间。
从来没有固定数量的行，所以我设置了VBA代码将格式应用于单元格范围，例如:
AssDateLastRow = shAss.Range("C" & Rows.Count).End(xlUp).Row
shAss.Range("C4:C" & AssDateLastRow).NumberFormat = "yyyy-mm-dd"
不是区域中的所有单元格都有正确的格式，它们将显示为15/04/2014而不是2014-04-15。如果我手动选择单元格并按F2然后按ENTER键，格式会根据我的需要出现。这种情况在整个范围内随机发生，可能有数千行，因此手动按F2+ENTER在工作表中搜索是不实际的。
我在网上看了看，发现什么应该自动做F2+输入与VBA。
下面的代码是从一组更大的代码行中提取出来的，所以Dim语句等在实际副本中更靠前，但这应该显示了我到目前为止解决这个问题的方式。
Dim shAss As Worksheet
Dim AssDateLastRow As Long
Dim c As Range
'enter method to format 'Date Craftperson Assigned' and 'Time Craftperson Assigned' in Assignments sheet
'column "C" and "D", to formats required by Archibus: date "yyyy-mm-dd", time "hh:mm.ss.ss"
AssDateLastRow = shAss.Range("C" & Rows.Count).End(xlUp).Row
shAss.Range("C4:C" & AssDateLastRow).NumberFormat = "yyyy-mm-dd"
'ensure format is applied by forcing F2 edit of cell
For Each c In shAss.Range("C4:C" & AssDateLastRow).Cells
c.Select
SendKeys "{F2}", True
SendKeys "{ENTER}", True
'Selection.NumberFormat = "yyyy-mm-dd"
Next
当我运行代码时，数据复制到我的工作表中，但日期和时间仍然是混合格式。
通过VBA强制F2+ENTER的尝试似乎没有做任何事情。如果手动操作，它可以正常工作。
下面是从工作表
的结果中复制数据的示例Work Request Code Date Assigned Time Assigned
92926 19/05/2014 14:30.00.00
92927 19/05/2014 15:00.00.00
92928 2014-05-19 15:15.00.00
92934 2014-05-19 14:00.00.00
92527 12/05/2014 07:30
92528 12/05/2014 08:00
92804 2014-05-12 16:15
92805 2014-05-12 16:20.00.00
我使用这个简单的宏应用F2 + 在当前选定的范围上输入:
Sub ApplyF2()
Selection.Value = Selection.FormulaR1C1
End Sub
我也努力让这个工作。我的问题不仅仅是日期，还有数据前面有一个单引号。我拼凑的东西对我很有用。它能快速清除超过7万个细胞。希望它对你有用:
(您可以根据需要更改范围等)
Dim MyRange As Range
Set MyRange = Range(Cells(2, 7), [G1].End(xlDown))
For Each MyRange In MyRange.Cells
'Mimic F2 without SendKeys
MyRange.Value = MyRange.Value
Next
我可以想到两个选项让Excel在一步中对单元格应用格式。
第一种方法是使用Text to columns功能，即使列中没有要分割的内容。第二个选项是复制值1并使用 paste Special - Multiply选项将其粘贴到单元格中。虽然任何一种方法都应该强制更新单元格格式，但我倾向于第一个选项。这是在你的一些日期被存储为文本的情况下。
Sub Format_Text_to_Columns()
Dim AssDateLastRow As Long
AssDateLastRow = ActiveSheet.Range("C" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("C4:C" & AssDateLastRow).NumberFormat = "yyyy-mm-dd;@"
'Set the format
Range("C4:C" & AssDateLastRow).Select
Selection.TextToColumns DataType:=xlDelimited, ConsecutiveDelimiter:=True, _
Space:=True, FieldInfo:=Array(1, 5)
'Use text to columns to force a format update
End Sub
Sub Format_Paste_Special_Multiply()
Dim AssDateLastRow As Long
AssDateLastRow = ActiveSheet.Range("C" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("C4:C" & AssDateLastRow).NumberFormat = "yyyy-mm-dd;@"
'Set the format
Range("C1").FormulaR1C1 = "1"
Range("C1").Copy
Range("C4:C" & AssDateLastRow).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlMultiply
Application.CutCopyMode = False
Range("C1").ClearContents
'Multiply the dates by 1 to force a format update
End Sub
这对我很有效。
Dim r As Range
Dim n As Integer
Dim AssDateLastRow As Long
AssDateLastRow = ActiveSheet.Range("E" & Rows.Count).End(xlUp).Row
Set r = Range("E2:E" & AssDateLastRow)
r.Select
r.NumberFormat = "ddmmyyyy;@"
r.Select
For n = 1 To r.Rows.Count
SendKeys "{F2}", True
SendKeys "{ENTER}", True
Next n
可以使用Text to Columns来解决这个问题
1)突出显示数据列
2)转到数据 -> 文本到列 -> 分隔符 ->(取消选中所有内容)-> 下一个
3)在向导的第3页设置列数据格式 YMD
4) 对
Sub RefreshCells()
Dim r As Range, rr As Range
Set rr = Selection
For Each r In rr
r.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.SendKeys "{F2}"
Application.SendKeys "{ENTER}"
Application.SendKeys "+{ENTER}"
DoEvents
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.SendKeys "{ENTER}"
DoEvents
Next
End Sub
您需要发送键F2 + Enter似乎很奇怪。运行宏之前的格式是什么?尝试用这种方式格式化整个列(它不会影响文本)。
Columns("C:C").NumberFormat = "yyyy-mm-dd"
我的变异
n = Selection.Rows.count
Dim r1 As range, rv As range
Set r1 = Selection.Cells(1, 1)
For I = 1 To n
Set rv = r1.offset(I - 1, 0)
vali = rv.value
IsNumeric(vali) Then
vali = CDbl(vali)
rv.value = 0
rv.value = vali
End If
尝试按F9或文件-选项-公式-工作簿计算-自动
我刚刚将顶部条目右侧的单元格设置为将问题单元格乘以1的公式。这个新单元格是一个正确的数字，然后双击手柄将它扩展到整个列，将它们全部固定!
Sendkeys不稳定。更好的方法是将文本存储在剪贴板中并粘贴。
查看如何在剪贴板中存储值
Sub CopyText(Text As String)
Dim MSForms_DataObject As Object
Set MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
MSForms_DataObject.SetText Text
MSForms_DataObject.PutInClipboard
Set MSForms_DataObject = Nothing
End Sub
Sub Test()
CopyText (ActiveCell.Value)
ActiveCell.PasteSpecial
End Sub
'In place of active cell, you may pass a range
这对我有用
Sub f2Cells(sel as Range)
Dim rng as Range
On Error GoTo exitHere
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
For Each rng In sel.Cells
If Not Intersect(sel, Application.Range(rng.Address)) Is Nothing And _
Application.Range(rng.Address).EntireColumn.Hidden = False And _
Application.Range(rng.Address).EntireRow.Hidden = False Then
Application.Range(rng.Address).Application.SendKeys "({F2}{ENTER})", True
End If
Next rng
exitHere:
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
Application.SendKeys "{NUMLOCK}", True
End Sub
然后从你的函数中调用
f2Cells shAss.Range("C4:C" & AssDateLastRow)
我明白了，Simple
选择您想要的所有单元格，按F2并回车，然后运行这个简短的宏:
Sub AutoF2Enter()
选择。值=选择。值
终止子
适用于日期和数字!
一秒钟5万个细胞!