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'否則它是一個痛苦的閱讀！謝謝。我這次爲你做了。 –
你的問題是什麼？ –
噢，是什麼問題？您是否嘗試在調試器模式下逐步執行代碼？ –