混合形式の日付を含む日付列があります。例えば:
A
1990年3月21日
1990年3月21日
したがって、基本的に1つの列にはdd.mm.yyyy
とmm/dd/yyyy
の2つの異なる形式があります。列のすべての日付の形式をyyyy-mm-dd
に変更するVBAスクリプトを作成しようとしています。それは私がこれまでに持っているものです:
Sub changeFormat()
Dim rLastCell As Range
Dim cell As Range, i As Long
Dim LValue As String
i = 1
With ActiveWorkbook.Worksheets("Sheet1")
Set rLastCell = .Range("A65536").End(xlUp)
On Error Resume Next
For Each cell In .Range("A1:A" & rLastCell.Row)
LValue = Format(cell.Value, "yyyy-mm-dd")
.Range("B" & i).Value = LValue
i = i + 1
Next cell
On Error GoTo 0
End With
End Sub
エレガントなコードではないことは知っていますが、私はVBAの初心者なので、ご容赦ください。そのコードの問題は、フォーマット関数の引数をyyyy-mm-dd
からdd/mm/yyyy
に変更すると、変更されていないA列が列Bに書き換えられることですが、フォーマットmm/dd/yyyy
の日付に対してのみ機能します。 、およびdd.mm.yyyy
はそのままにします。何かアドバイスをいただければ幸いです。
更新:新しい回答
これがその仕事をする解決策です!サブルーチンには、置換を行う関数が含まれています(関数自体は本当に便利です!)。サブを実行すると、列Aのすべてのオカレンスが修正されます。
Sub FixDates()
Dim cell As range
Dim lastRow As Long
lastRow = range("A" & Rows.count).End(xlUp).Row
For Each cell In range("A1:A" & lastRow)
If InStr(cell.Value, ".") <> 0 Then
cell.Value = RegexReplace(cell.Value, _
"(\d{2})\.(\d{2})\.(\d{4})", "$3-$2-$1")
End If
If InStr(cell.Value, "/") <> 0 Then
cell.Value = RegexReplace(cell.Value, _
"(\d{2})/(\d{2})/(\d{4})", "$3-$1-$2")
End If
cell.NumberFormat = "yyyy-mm-d;@"
Next
End Sub
この関数を同じモジュールに配置します。
Function RegexReplace(ByVal text As String, _
ByVal replace_what As String, _
ByVal replace_with As String) As String
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
RE.pattern = replace_what
RE.Global = True
RegexReplace = RE.Replace(text, replace_with)
End Function
仕組み:正規表現を使用して置換を実行できる気の利いたRegexReplace関数があります。サブはA列をわずかにループし、言及した2つのケースの正規表現を置き換えます。私が最初にInstr()を使用する理由は、交換が必要かどうか、そしてどの種類かを判断するためです。技術的にはこれをスキップできますが、それを必要としないセルで置換を行うと、非常にコストがかかります。最後に、安全対策のために、中身に関係なく、セルをカスタムの日付形式にフォーマットします。
正規表現に慣れていない場合(参照: http://www.regular-expressions.info/ )、私が使用している式は次のとおりです。
これにはVBAは本当に必要ありません。このワンライナーワークシートの数式でうまくいきます。
=IF(ISERROR(FIND(".",A1)),IF(ISERROR(FIND("/",A1)),"invalid format",
DATE(RIGHT(A1,4),LEFT(A1,2),MID(A1,4,2))),
DATE(RIGHT(A1,4),MID(A1,4,2),LEFT(A1,2)))
これは、日と月が常に2桁の数字として与えられ(たとえば、常に03で、3だけではない)、年が4桁である(つまり、1000〜 9999年に「制限」されている)ことを前提としています。ただし、これが当てはまらない場合は、目的に合わせて数式を簡単に調整できます。
これがあなたが望むことをするかどうか見てください。あなたはそれをあなた自身のアプリケーションのために少し調整しなければならないかもしれません。
お役に立てれば!
Sub convertDates()
Dim rRng As Range
Dim rCell As Range
Dim sDest As String
Dim sYear, sMonth, sDay, aDate
'Range where the dates are stored, excluding header
Set rRng = Sheet1.Range("A2:A11")
'Column name of destination
sDest = "B"
'You could also use the following, and just select the range.
'Set rRng = Application.selection
For Each rCell In rRng.Cells
sYear = 99999
If InStr(rCell.Value, ".") > 0 Then
aDate = Split(rCell.Value, ".")
If UBound(aDate) = 2 Then
sDay = aDate(0)
sMonth = aDate(1)
sYear = aDate(2)
End If
ElseIf InStr(rCell.Value, "/") > 0 Then
aDate = Split(rCell.Value, "/")
If UBound(aDate) = 2 Then
sDay = aDate(1)
sMonth = aDate(0)
sYear = aDate(2)
End If
End If
With rCell.Range(sDest & "1")
If sYear <> 99999 Then
On Error Resume Next
.Value = "'" & Format(CDate(sMonth & "/" & sDay & "/" & sYear), "YYYY-MM-DD")
'If it can't convert the date, just put the original value in the dest
'cell. You can tailor this to your own preference.
If Err.Number <> 0 Then .Value = rCell.Value
On Error GoTo 0
Else
.Value = rCell.Value
End If
End With
Next
End Sub
@Jean-FrançoisCorbettには、機能する数式ソリューションがありますが、エラーメッセージ(#VALUE!
が有益であることに基づいて)と別のIF(両方ともDATE)を前に置くことで、半分以上短縮される可能性があります。 ISERROR、および1つのLEFT、MID、RIGHTセットの代わりにSUBSTITUTE:
=IFERROR(1*(MID(A1,4,3)&LEFT(A1,3)&RIGHT(A1,4)),1*SUBSTITUTE(A1,".","/"))
これは、コメントで@Issunによって言及された解釈をOPに適用し、出力がyyyy-mm-dd
でフォーマットされたセルにあると想定します。
次のようなサブルーチンで記述できます。
Sub Macro1()
Range("B1:B10").Formula = "=IFERROR(1*(MID(A1,4,3)&LEFT(A1,3)&RIGHT(A1,4)),1*SUBSTITUTE(A1,""."",""/""))"
End Sub
これに対する簡単な解決策は次のとおりです。
Sub ChangeFormat1()
Dim ws as Worksheet
Set ws = Thisworkbook.Sheets("Sheet1")
LR = ws.cells(rows.count,1).End(Xlup).Row
with ws
For I = 1 to LR
.cells(I,2).value = .cells(I,1).value
Next
End with
ws.range("B1:B" & LR).numberformat = "yyyy-mm-dd"
End Sub