0
此代码的目的是格式化3个不同MS Excel文件的日期。每个文件都以不同的名称开头。一个是AT，另一个是PT，最后是MX。根据文件名称中的前两个字符，日期格式会有所不同。将不同日期格式格式化为标准格式
例如：
当日期是这样的PT和AT：20100710
我们使用这个公式：
=RIGHT(B38;2)&"."&MID(B38;5;2)&"."&LEFT(B38;4)
结果是：10.07.2010
当日期是这样的MX：1/1/2010
我们使用这个公式：
="0"&LEFT(B39;1)&"."&"0"&MID(B39;3;1)&"."&RIGHT(B39;4)
结果是：01.01.2010
然后我们使用Excel的格式将其更改为：dd.mm.year
的纸张被称为“数据”，它是Excel文件中唯一的活动工作表。
该代码目前什么都不做，没有错误等。它循环通过文件夹中的工作表并保存它们。它不会改变“AT”或“PT”的日期。
Option Explicit
Public Sub FormatDates()
Dim wbOpen As Workbook
Dim strExtension As String
Const strPath As String = "H:\" 'Change Path to the folder you have your files in
'Comment out the 3 lines below to debug
' Application.ScreenUpdating = False
' Application.Calculation = xlCalculationManual
' On Error Resume Next
ChDir strPath
strExtension = Dir(strPath & "*.xls") 'change to xls if using pre 2007 excel
Do While strExtension <> ""
Set wbOpen = Workbooks.Open(strPath & strExtension)
With wbOpen
If Left(LCase(.Name), 2) = "pt" Or Left(LCase(.Name), 2) = "at" Then 'change to lower case and check start of name
ChangeAllDates ("NOT MX")
.Close SaveChanges:=True
ElseIf Left(LCase(.Name), 2) = "mx" Then
ChangeAllDates ("MX")
.Close SaveChanges:=True
Else
.Close SaveChanges:=False
End If
End With
strExtension = Dir
Loop
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
On Error GoTo 0
End Sub
Private Function ChangeAllDates(strType As String)
Dim strTemp As String
Dim strCellValue As String
Dim rng As Range
Dim cell As Range
Dim sht As Worksheet
Set sht = ActiveSheet
Sheets("data").Activate 'selects sheet named data
Set rng = Range("C2:C" & GetLastPopulatedCell(2, 2, sht)) 'finds last populated cell
On Error GoTo err_check
For Each cell In rng
strCellValue = CStr(cell.Value)
If Len(strCellValue) > 2 Then 'only check cells that have more than 2 charactors in them
If InStr(1, strCellValue, ".", vbTextCompare) = 0 Then
If strType = "MX" Then
strTemp = Left(strCellValue, 4) & "." & Mid(strCellValue, 5, 2) & "." & Right(strCellValue, 2)
Else
strTemp = Right(strCellValue, 2) & "." & Mid(strCellValue, 5, 2) & "." & Left(strCellValue, 2)
End If
If InStr(1, strCellValue, "/", vbTextCompare) > 0 Then 'change data/to .
strTemp = Replace(strCellValue, "/", ".", 1, , vbTextCompare)
'now check to make sure that it reads yyyy.mm.dd if not then we need to reverse it and check
'it has 2 numbers for month and year
strTemp = CheckDataFormat(strTemp)
End If
Else
strTemp = strCellValue
End If
cell.Value = strTemp 'replace the cell value with the formatted value
strCellValue = ""
strTemp = ""
End If
Next cell
On Error GoTo 0
Exit Function
err_check:
MsgBox Error.Name & vbCrLf & "Error happend on cell " & cell.Address
End Function
Private Function GetLastPopulatedCell(lgRow As Long, lgCol As Long, sht As Worksheet) As Long
Dim i As Integer
Dim s As String
For i = 0 To 10000 'set a default number of cells to check in this case I have set it to 10,000
If sht.Cells(lgRow, lgCol).Value <> "" Then
lgRow = lgRow + 1
Else
GetLastPopulatedCell = lgRow - 1
Exit For
End If
Next i
End Function
Private Function CheckDataFormat(str As String) As String
Dim strR As String
Dim i As Integer
Dim vArray As Variant
'str = "06.01.2011"
'have to check if date is in d.m.yyyy format if so we need to change it to dd.mm.yyyy
If Len(str) < 10 Then 'only care if less than 10 charators
vArray = Split(str, ".") 'split into array on points
str = ""
For i = 0 To UBound(vArray)
If Len(vArray(i)) = 1 Then 'if only 1 charactor long we know we are missing 0
str = str & "0" & vArray(i) & "." 'check if 0 exists before number if not add it
Else
str = str & vArray(i) & "."
End If
Next i
'remove last dot on the end
If Right(str, 1) = "." Then str = Left(str, Len(str) - 1)
End If
Debug.Print str
'strR = Right(str, 5)
'If Left(strR, 1) = "." Then
' str = Right(str, 4) & "." & Left(str, (Len(str) - 5)) 'move the year to the front
' str = Left(str, 5) & Right(str, 2) & Mid(str, 5, 3) 'switch round month and day
' Debug.Print str
'End If
CheckDataFormat = str
End Function
@ user787601：请格式化代码'code'否则它是一个痛苦的阅读！谢谢。我这次为你做了。 –
你的问题是什么？ –
噢，是什么问题？您是否尝试在调试器模式下逐步执行代码？ –