FC2ブログ
エホバの証人二世の、個人研究&趣味blogです。
2018/07«│ 2018/08| 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 »2018/09
文字色の変化のON/OFFが出来ます。文字サイズ文字サイズ:大文字サイズ:中文字サイズ:小
07:30:49
Sub ggge年m月に変更する()
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim s As Variant
If Selection.Count <> 1 Then
s = Selection
Dim j As Long
Dim k As Long
For j = 1 To UBound(s)
For k = 1 To UBound(s, 2)
If IsDate(s(j, k)) = True Then
s(j, k) = Format(s(j, k), "ggge") & "年" & Format(s(j, k), "m")
Else
s(j, k) = Replace(s(j, k), ".", "/")
If IsDate(s(j, k)) = False Then
s(j, k) = s(j, k) & "/1"
End If
s(j, k) = CDate(s(j, k))
s(j, k) = Format(s(j, k), "ggge") & "年" & Format(s(j, k), "m") & "月"
End If

Next
Next
Else
If IsDate(Selection.Value) = True Then
Selection.Value = Format(Selection.Value, "ggge") & "年" & Format(Selection.Value, "m")
Else
Selection.Value = Replace(Selection.Value, ".", "/")
If IsDate(Selection.Value) = False Then
Selection.Value = Selection.Value & "/1"
End If
Selection.Value = CDate(Selection.Value)
Selection.Value = Format(Selection.Value, "ggge") & "年" & Format(Selection.Value, "m") & "月"
End If

End If
Selection = s
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
On Error GoTo 0
End Sub

Sub 移動つめマクロ()
Dim buf As Range
Set buf = Application.InputBox(Prompt:="移動するセルを選択してください。", Type:=8)

Dim buf2 As Range
Set buf2 = Application.InputBox(Prompt:="移動先のセルを選択してください。", Type:=8)

Dim buf3 As Range
Set buf3 = Application.InputBox(Prompt:="詰めるセルを選択してください。", Type:=8)

Dim buf_buf As Variant
buf_buf = Range(buf.Address)

Range(buf2.Address) = buf_buf
buf_buf = Range(buf3.Address)
Range(buf3.Address) = ""
Range(Cells(buf.Row, buf.Column), Cells(buf.Row + UBound(buf_buf) - 1, buf3.Column + 1)) = buf_buf
End Sub


selectionを直ぐ配列代入することがお勧めです。








超可愛い~~~。こういうの好きです//////

コメント
コメントの投稿










トラックバック
トラックバックURL
→http://ayukt0526.blog.fc2.com/tb.php/294-e4527ee8
この記事にトラックバックする(FC2ブログユーザー)
プロフィール

はなかな

Author:はなかな
FC2ブログへようこそ!

最新記事
最新コメント
月別アーカイブ
カテゴリ
フリーエリア
ランキング参加しています。 にほんブログ村 哲学・思想ブログ エホバの証人へ にほんブログ村 にほんブログ村 本ブログ 読書日記へ にほんブログ村 にほんブログ村 音楽ブログへ にほんブログ村
音楽(J-POP) ブログランキングへ
小説(読書感想) ブログランキングへ
キリスト教 ブログランキングへ
ブログランキング ブログ王ランキングに参加中!
検索フォーム
RSSリンクの表示
リンク
このブログをリンクに追加する
ブロとも申請フォーム

この人とブロともになる

QRコード
QR
FC2アフィリエイト