繁体   English   中英

替代 SendKeys Enter 以使用 vba 在 excel 中激活单元格

[英]Alternative to SendKeys Enter for activating cells in excel with vba

我正在使用宏将 csv 文件中的一些日期粘贴到 excel 中,并使用查找/替换将格式更改为一个 excel 可以识别的格式,例如,从 2019_10_22_08_43_23 到 22/10/2019 08:43:23。 在您手动选择单元格并按 Enter 之前,Excel 不会将此文本识别为日期,因此在完成此操作之前不会在图表上正确显示日期。 我目前的解决方案是使用

For Each c In cycleRange.Cells
c.Select 
SendKeys "{F2}", True
SendKeys "{ENTER}", True
Next

在每个单元格中手动按 Enter 键,但这需要很长时间。 我曾尝试使用 TextToColumns 但这不起作用。 如果我手动选择单元格范围,并导航数据菜单以自己单击 TextToColumn 它会更正单元格格式,但通过宏执行此操作不会执行任何操作。

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

替换遍历每个单元格并使用 Sendkeys 激活它们的最快方法是什么?

您想将每个单元格转换为数字。 这是代码:

Dim cellValue As Double

For Each c In cycleRange.Cells
    If IsNumeric(c.Text) Then
        cellValue = c.Value
        c.Clear
        c.NumberFormat = "0.00"
        c = Val(c.Text)
        ' c = c.Text * 1
        ' c = CDbl(c.Text)
    Else
        MsgBox ("Not a number (" & c.Address & ")")
    End If
Next

将字符串转换和单元格格式合并为一个 VBA 操作会更容易

像这样的东西

Sub Demo()
    Dim rng As Range
    Dim cl As Range
    Dim dat() As String
    
    Set rng = [A1:A10] ' update to suit your needs
    
    For Each cl In rng
        If cl.Value2 Like "####_##_##_##_##_##" Then
            dat = Split(cl.Value2, "_")
            cl = DateSerial(dat(0), dat(1), dat(2)) + TimeSerial(dat(3), dat(4), dat(5))
            cl.NumberFormat = "yy/mm/dd hh:mm:ss" ' update to suit your required format
        End If
    Next
End Sub

您可以模拟输入一个单元格并通过自行替换特定数字来按回车键,即将 1 替换为 1。因此,格式会发生变化。 对 0、1、然后 2 到 9 执行此操作将覆盖您的所有单元格,无论单元格中的数字如何。

这里有一个宏:

Sub Repl1by1()
    Cells.Replace What:="0", Replacement:="0", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="1", Replacement:="1", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="2", Replacement:="2", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="3", Replacement:="3", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="4", Replacement:="4", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="5", Replacement:="5", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="6", Replacement:="6", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="7", Replacement:="7", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="8", Replacement:="8", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="9", Replacement:="9", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

End Sub

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM