- ベストアンサー
エクセルでの和暦変換方法
- エクセルでの和暦変換方法について教えてください。
- マクロを使用して、特定の日付の和暦表記を取得する方法を教えてください。
- ウィンドウズ７とエクセル２０１０を使用しています。1234/56/78のデータでは和暦変換できますが、単一の数字だけでは変換できません。どの部分を変更すればいいのか教えてください。
- yairi1106
- お礼率50% (80/157)
- Visual Basic
- 回答数2
- ありがとう数1
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
その他の回答 (1)
- imogasi
- ベストアンサー率27% (4737/17068)
（１）エクセルを使わないで、計算処理的に和暦変換も不可能ではないだろう。しかし暦に関する江戸時代以前の昔の智識がいる。事実上一般人には不可能。 （２）そういう専用のソフトを使う手もある。 （３）エクセルを使うものなら、エクセルを使うのが便利。 しかし対象となる年には制限があることに気を付けて。 質問はこのへんに無頓着な、大げさな標題と例示になっているが、対象は明治大正昭和平成で無いのか。 ＞1234/56/78なんて例示が悪いと思う。 ほんとに西暦１２００年代を考えているのか。だったらエクセルなんかのカテに質問すべきでない。 ーー エクセルでやるなら、すべてはセルの値（または変数の値が）が、日付シリアル値になっていることが必要。この言葉は初耳なんてでないだろうね。 だから19991202なども1990年12月2日の日付シリアル値に直すべきだ。 それは関数で出来る。その後はそのセルの表示形式を日付の年号つきのものに設定する。 A1セルに 19991202 とあるとして =DATE(LEFT(A1,4),MID(A1,5,2),RIGHT(A1,2)) （）内はMiD関数ばかりでデモできる またDATEVALUE関数でも出来る。その場合1999/12/02という文字列を作り＝DATEVALUE（）のカッコ内に入れる。 表示形式の設定の点は同じ。
補足
ご回答ありがとうございます。 細かく話すと質問が長くなってしまいますので かなり省略してしまいました。 実際には今現在明治・大正・昭和のみです。 提示例も悪かったですが、細かい仕様に関しては 検証済みで、元年の切り替えも対応はＶＢＡで出来てます。 または年・月・日を３フィールドに分割して そこからコードを書けば 対応は出来ているのですが・・・ 色々参考にはなりましたが、マクロで組みたいと思っております。 どうもありがとうございました。
関連するQ&A
- ExcelVBAで行と列の検索
Ａ Ｂ Ｃ Ｄ Ｅ １ コード あ い う え ２ １０ ○ ○ ３ ２０ ○ ○ ４ ３０ ○ 上記の表が5000件あります。Textbox1に入力し検索ボタンを押すと A列のコードを検索して一致する列の○のあるところの１行目の項目 をtextbox2に表示したいのですがうまく行きません。 よろしくお願い致します。 Private Sub CommandButton1_Click() '検索フォームボタン Dim i As Long Dim 最終行 As String Dim サーチ行 As Long Sheets(1).Activate 最終行 = Range("A1").End(xlDown).Row サーチ行 = 0 For i = 2 To 最終行 If TextBox1.Value = Range("A" & i) Then If Range("B" & i, "N" & i) = "" Then TextBox2.Text = Range("B1", "N1") サーチ行 = i Exit For End If End If Next If サーチ行 = 0 Then MsgBox TextBox1.Value & "データはありません。", vbInformation, "無し" End If TextBox1.SetFocus End Sub エラーはでません。データはありませんとなります。
- ベストアンサー
- その他（プログラミング・開発）
- 文字変換マクロについて
数値を文字列に変換するマクロで、行数や列数が増えても対応できるようにしたいです。 （並びは…数値 スペース 文字列）どなたか教えてください。 よろしくお願いします。 Sub 文字() Dim i As Long For i = 1 To Range("A1").End(xlDown).Row Cells(i, "C") = Cells(i, "A") With Cells(i, "C") .NumberFormatLocal = "@" .Value = StrConv(Cells(i, "C").Value, vbNarrow) .Value = Format(Cells(i, "C").Value, "'00") End With Next i End Sub
- ベストアンサー
- Excel（エクセル）
- 空白行の削除マクロについてご教示ください
空白行の削除に、下記マクロを活用させていただいていますが、 見た目空白なのに削除されない行が時々残ってしまいます。 削除されなかったセルを「Deleteキー」で空白にするとマクロが 実行され、きちんと削除されます。 こういった、スペースか何かが入っていても、見た目空白なら 削除するようにはできないでしょうか。 どなたかよろしくお願いいたします。 Sub 削除() Dim c As Range Dim 開始行 As Long Dim 最終行 As Long 開始行 = 5 最終行 = Range("a5000").End(xlUp).Row For Each c In Range("a" & 開始行 & ":a" & 最終行) If c.Value = "" Then Rows(c.Row).Delete End If Next End Sub
- ベストアンサー
- オフィス系ソフト
- 配列に格納したデータを指定行以下に転記する方法
excel2000を使っています。 以下のコードだと最終行にデータが転記されます。これを４行目に確定して、転記したいのです。常に４行目つまりＡ列４行目以下に上書きしたいのです。 その場合コードをどのように変更すべきでしょうか？ Sub 配列() With ActiveSheet ' 配列に格納 --------------------------- Dim i As Integer Dim LastRow As Long Dim SaleAry As Variant ' 配列に格納 --------------------------- SaleAry = Array(.Range("t4"), .Range("e5"), .Range("ｇ5"), .Range("o5")) End With ' 転記 --------------------------- With Worksheets("daityou") LastRow = .Range("A65536").End(xlUp).Row For i = 0 To UBound(SaleAry) .Cells(LastRow + 1, i + 1).Value = SaleAry(i) ' Next i End With Set SaleAry = Nothing End Sub
- ベストアンサー
- オフィス系ソフト
- ｃomboboxで任意の行列を削除する
ｃomboboxで選択したデーターを探して、その行の ２列目から45列までを、削除する方法をお教えください。 下のように記述したのですが、１行全てが削除されてしまいます。 どのように記述したらよいのでしょうか。 よろしくお願いします。 Private Sub 保存データー削除_Click() Dim i As Long For i = 2 To 199 If Cells(i, 2).Value = ｃombobox1.Value Then Range(i & ":" & i).Delete End If Next i Dim k As Long, s As Long k = 1 For s = 1 To 31 Cells(s, 1).Value = k k = k + 1 Next s End Sub
- ベストアンサー
- その他（プログラミング・開発）
- Next,End Withのエラー
Sub 入力() If Sheets("入力").Range("D3").Value = "" Then MsgBox "客先名を入力して下さい" Else Dim K最終行 As Long Dim T最終行 As Long Dim i As Integer With Sheets("入力") For i = 3 To 12 If .Cells(i, "H").Value <> "" Then U最終行 = Sheets("注文書").Range("G65536").End(xlUp).Row + 1 If U最終行 = 461 Then MsgBox "注文書がいっぱいです" Exit Sub Else End If E最終行 = Sheets("営業確認").Range("G65536").End(xlUp).Row + 1 Sheets("営業確認").Range("k" & E最終行).Value = .Cells(i, "b").Value Sheets("営業確認").Range("b" & E最終行).Value = .Cells(i, "c").Value Sheets("営業確認").Range("c" & E最終行).Value = .Cells(i, "d").Value Sheets("営業確認").Range("d" & E最終行).Value = .Cells(i, "e").Value Sheets("営業確認").Range("g" & E最終行).Value = .Cells(i, "h").Value Sheets("営業確認").Range("f" & E最終行).Value = .Cells(i, "i").Value Sheets("営業確認").Range("i" & E最終行).Value = .Cells(i, "m").Value Sheets("営業確認").Range("h" & E最終行).Value = .Cells(i, "p").Value Else End If Select Case .Cells(i, "o").Value Case "北" K最終行 = Sheets("北").Range("h65536").End(xlUp).Row + 1 Sheets("北").Range("B" & K最終行).Value = .Cells(3, "C").Value Sheets("北").Range("c" & K最終行).Value = .Cells(3, "b").Value Case "中" T最終行 = Sheets("中").Range("H65536").End(xlUp).Row + 1 Sheets("中").Range("b" & T最終行).Value = .Cells(3, "c").Value Sheets("中").Range("c" & T最終行).Value = .Cells(3, "b").Value End Select Exit Sub Dim Dummy As Worksheet Dim SheetName As String Dim OTA As Long Dim GEN As Long Dim SheetName2 As String With Sheets("入力") '3行目～22行目まで For j = 3 To 22 SheetName = Sheets("入力").Range("D3").Value On Error Resume Next Set Dummy = Sheets(SheetName) SheetName2 = .Cells(i, 14).Value 'もしシートがあれば・・・ If Err.Number = 0 Then 'SheetName2は入力シートのN行 SheetName2 = .Cells(i, 14).Value OTA = Sheets(SheetName2).Range("B65536").End(xlUp).Row + 1 Sheets(SheetName2).Range("A7").Value = .Cells(3, "D").Value Sheets(SheetName2).Range("C3").Value = .Cells(3, "C").Value Sheets(SheetName2).Range("B" & OTA).Value = .Cells(i, "H").Value Sheets(SheetName2).Range("I" & OTA).Value = .Cells(i, "I").Value Sheets(SheetName2).Range("F" & OTA).Value = .Cells(i, "K").Value Sheets(SheetName2).Range("H" & OTA).Value = .Cells(i, "L").Value Sheets(SheetName2).Range("J" & OTA).Value = .Cells(i, "M").Value 'シートが無ければ・・・ Else GEN = Sheets("原紙").Range("B65536").End(xlUp).Row + 1 Sheets("原紙").Range("A7").Value = .Cells(3, "D").Value Sheets("原紙").Range("C3").Value = .Cells(3, "C").Value Sheets("原紙").Range("B" & GEN).Value = .Cells(i, "H").Value Sheets("原紙").Range("I" & GEN).Value = .Cells(i, "I").Value Sheets("原紙").Range("F" & GEN).Value = .Cells(i, "K").Value Sheets("原紙").Range("H" & GEN).Value = .Cells(i, "L").Value Sheets("原紙").Range("J" & GEN).Value = .Cells(i, "M").Value '原紙をコピーする Sheets("原紙").Copy BEFORE:=Sheets(1) 'シートの名前を市場コードにする Sheets(1).Name = SheetName Next End With Exit Sub On Error GoTo 0 Sheets("原紙").Select Range("C3:E3,A7,B16:B35,F16:F35,H16:J35").Select Range("H35").Activate Selection.ClearContents Sheets("入力").Select Sheets("入力").Range("D3,G3:J12,L3:M12").Value = "" Sheets("入力").Range("D3").Select Range("B3").Formula = "=IF(D3="""","""",VLOOKUP(D3,'\\Seika-sv01\支店共有\マーケティング用\[担当者リスト.xls]リスト形式'!$B:$D,3,FALSE))" MsgBox "入力が完了しました" End If End Sub 上記のようにマクロを組みましたがエラーが出てしまいます。
- 締切済み
- その他（プログラミング・開発）
- 行に色を付ける
本を片手にやっているのですが 分かっている人にしたらあほみたいなことなんでしょうがよろしくお願いします。 A列には日付B列には曜日（WEEKDAY関数で日曜が1）を入力してあります。土日の行ににピンクを塗りつぶしたいのですが Sub iro() Dim i As Integer, gyou As Long gyou = Range("b65536").End(xlUp).Row For i = 2 To gyou If Range("b65536").End(xlUp).Value = 1 Or 7 Then Rows(i).Interior.ColorIndex = 7 Else Exit For End If Next End Sub なんとなくここまでできたのですが、これだと 全部の行に色がついてしまいます。 何がいけないのでしょうか？ よろしくお願いします。
- 締切済み
- オフィス系ソフト
- Excel VBA でテキストボックスの値をセルA列から検索
いつもお世話になります。 Private Sub CommandButton3_Click() Dim 行 As String Dim 列 As String Dim 最終行 As String Dim 検索行 As String Dim メッセージ As Integer Dim 一致 As Range Dim myNO As Variant Dim i As Long Sheets(3).Select 最終行 = Range("A2").End(xlDown).Offset(1).Select 行 = ActiveCell.Row 列 = ActiveCell.Column myNO = TextBox2.Value 検索行 = Range("A2").End(xlDown).Select ※・・・Set 一致 = Range("A2:検索検").Findwhat:=TextBox2,lookat:=xlWhole) If 一致 Is Nothing Then MsgBox "データがありません。新規コード入力します。" Cells(行, 列 + 0) = UserForm1.TextBox2.Value Cells(行, 列 + 1) = UserForm1.ComboBox7.Value Else i = Cells(行 - 1, "A") Cells(i, 列 + 0) = UserForm1.TextBox2.Value Cells(i, 列 + 1) = UserForm1.ComboBox7.Value End If End Sub 「エラー1004'Range'メソッドは失敗しました'Global'オブジェクト」とでます。※印が黄色になっています。 ユーザーフォーム1のテキストボックスの値をシート3のA列から検索して、一致すれば、A列の一致セルに上書き入力して、一致が無い場合はA列の空白セルに追加入力したいのです。よろしくお願い致します。
- ベストアンサー
- その他（プログラミング・開発）
- 最終列に入力されている文字を表示する
エクセルVBAで最終列に入力されている値の表示方法について教えてください。 最終行については表示できるのですが、最終列に入力されているものの表示がうまくいきません。 A列の最終行の値をセル”D1”に表示するについては Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Long r = Cells(Rows.Count, 1).End(xlUp).Row Range("D1").Value = Cells(r, 1).Value End Sub でうまくいきました。 最終行、例えば3列目の10行目に”111”と入力されているときにセル”D1”に”111”と表示するようにはどうしたらよいのでしょうか。 どなたがご指南ください宜しくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセルのVBAで質問があります。
現在自分はカレンダーを作成していて、カレンダーに祝日を入れたいと思っています そこで これを if文もしくはselectcase どっちを使ったら楽か教えてもらいたいです Sub MakeCalendar(hi As Date) Dim i As Integer 'カレンダーにセットする日付 Dim g As Integer '日付をセットする行番号 Dim r As Integer '日付をセットする列番号 Dim lastDay As Integer '作成するカレンダーの月末 g = 2 'その月の開始曜日を算出 r = Weekday(DateSerial(Year(hi), Month(hi), 1), vbSunday) '指定された日付の翌月１日をもとて、日付の前の日を計算する lastDay = Day(DateSerial(Year(hi), Month(hi) + 1, 1) - 1) For i = 1 To lastDay 'iに日付の設定 Cells(g, r).Value = i If r = 7 Then r = 1 '戻して g = g + 1 '1行下に書く Else r = r + 1 '１列→に移動する End If Next End Sub Sub test() Range("A2:G7").Value = "" 'A2～G2にカレンダー表示 MakeCalendar Range("I2").Value 'I2に日付を入力する End Sub Sub test() Range("A2:G7").Value = "" 'A2～G2にカレンダー表示 MakeCalendar Range("I2").Value 'I2に日付を入力する End Sub このようなマクロを組んでいまして、祝日（ゴールデンウィークなど)を赤で塗りつぶすような物を考えています。 VBAは初心者でまだあまりわかっていないので、ご教授ください
- 締切済み
- 情報工学
お礼
ご回答ありがとうございます。 ずばり解決しました。 ＞日付 = CVDate(Format(Range("A" & i), "0000/00/00")) こういったコードを考えてたのですがなかなかうまくいかなくて・・・ ご質問してよかったです。 因みに最終行までは、ループさせているのですが 今回は１００行目までとしました。 またつまずいた時には、ご教授お願いいたします。 どうもありがとうございました。