Question

我的数据提供程序已经更改了.XLSX文件中的一些内容。我已根据此应用程序所期望的模型添加了一个新子来修复数据：

Sub Feb27FixModel()
    ActiveSheet.Range("H2").End(xlDown).NumberFormat = "dd-mmm-yyyy"            'change format of Processed Date
    Dim colNum As Integer
    colNum = ActiveSheet.Rows(1).Find(what:="Legacy code", lookat:=xlWhole).Column
    ' Done twice to insert 2 new cols
    ActiveSheet.Columns(colNum + 1).Insert
    ActiveSheet.Columns(colNum + 1).Insert
    ' New col headings
    ActiveSheet.Cells(1, colNum + 1).Value = "Origin Code"
    ActiveSheet.Cells(1, colNum + 2).Value = "Jurisdiction Code"
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "County Name"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "State Abbreviation"
    ActiveWorkbook.Save
End Sub

除了上面第1行的结果外，一切都有效。在活动工作表中，列H的标题行值为“已处理日期”，H2单元格及其下方的单元格将作为常规存储，其值为11/15/2016。我需要将所有日期更改为自定义日期为dd-mmm-yyyy。以下声明未能为我完成此任务：

ActiveSheet.Range("H2").End(xlDown).NumberFormat = "dd-mmm-yyyy"

编辑（01March2017）：

感谢下面@Jeeped的回答，我添加了另一个声明，这是解决方案的代码：

With ActiveSheet
    .Range(.Cells(2, "H"), .Cells(.Rows.Count, "H").End(xlUp)).NumberFormat = "dd-mmm-yyyy"
    .Range(.Cells(2, "H"), .Cells(.Rows.Count, "H").End(xlUp)).Value = ActiveCell.Text
End With

编辑（02March2017）：

我昨天弄错了。在调试中，我必须在工作表中的断点处选择了一个好的单元格;因此，参考ActiveCell.Text“有点工作”。它具有将文本复制为“H-H-2016”的每一行的第14行（第一行除外）的效果。这是最低限度的可接受的。

我真正需要的是一个声明，它将采用H列的所有行的文本，并将存储的值从2016年10月14日更改为2016年10月14日等等。仅仅更改是不够的自定义格式。我也需要更改存储的值。我不知道该怎么做。

Answer 1

您只在最后一个单元格中操作，其值为H列。从H2到最后一个单元格，设置所有单元格的格式。

with ActiveSheet
    .Range(.cells(2, "H"), .cells(.rows.count, "H").End(xlUp)).NumberFormat = "dd-mmm-yyyy"
end with

Answer 2

这个四线循环应该可以解决问题。测试过它。 ;）

For i = 2 To Columns("H").End(xlDown).Row 'from row nr 2 to the rownr of last cell of column H
    Set currentCell = Cells(i, "h")
    currentCell.Value = Format(currentCell.Value, "dd-mm-yyyy")
Next i

它遍历每个单元格并在它们上应用Format()函数来转换文本格式。如果有帮助，请告诉我。

Answer 3

刚刚解决了同样的问题。也测试了你的情况。关键是TextToColumns命令。使用您的代码，尝试一下：

With ActiveSheet.Range("H:H")
    .NumberFormat = "dd-mmm-yyyy"
    .TextToColumns
End With

Answer 4

Sub Letsgive_try1() Dim MyPath As String, FilesInPath As String Dim MyFiles() 作为字符串 Dim SourceRcount As Long, Fnum As Long Dim mybook 作为工作簿，BaseWks 作为工作表 Dim sourceRange As Range, destrange As Range Dim rnum As Long，CalcMode As Long

'paste your path here
MyPath = "C:\Users\ThakareK\Documents\Box Support Files\Voice Acq\"

'Just for safer side if you forget to add \
If Right(MyPath, 1) <> "\" Then
    MyPath = MyPath & "\"
End If

'to check all excel files in you files folder directory
FilesInPath = Dir(MyPath & "*.csv*")
If FilesInPath = "" Then
    MsgBox "No files found"
    Exit Sub
End If

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
    Fnum = Fnum + 1
    ReDim Preserve MyFiles(1 To Fnum)
    MyFiles(Fnum) = FilesInPath
    FilesInPath = Dir()
Loop

'Change ScreenUpdating, Calculation and EnableEvents
With Application
    CalcMode = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
End With

'Add a new workbook with name test you can change as per yours below
Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    ActiveWorkbook.SaveAs Filename:="Test.xlsx"
rnum = 1

'Main part starts here Loop through all files in the array(myFiles)
'if you want to change data format add your range of cell and give date fomrat of your need

If Fnum > 0 Then
    For Fnum = LBound(MyFiles) To UBound(MyFiles)
        Set mybook = Nothing
        On Error Resume Next
        Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
        mybook.Activate
        
        
        'this part copies dynamic data
        Range("A1").Select
        Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
        
      
        'this part pastes data in new excel we genertaed
        Windows("TEST.xlsx").Activate
       
        With Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(0)
       .PasteSpecial Paste:=xlPasteColumnWidths
       .PasteSpecial Paste:=xlPasteValues
        End With
        
        
        'if you want to change data format add your range of cell instead of(G:G) and give date fomrat of your need
        With ActiveSheet.Range("G:G")
       .NumberFormat = "mm-dd-yyyy"
       .TextToColumns
        End With
        
        mybook.Close savechanges:=False
        
        On Error GoTo 0

           

    Next Fnum
    BaseWks.Columns.AutoFit
End If

退出子： '恢复屏幕更新、计算和启用事件有申请 .ScreenUpdating = 真 .EnableEvents = True .Calculation = CalcMode 结束于结束子

VBA Excel加载项：用于将列格式从常规日期更改为自定义日期的代码

4 个答案: