表記のとおりです。
Excel97で、マクロ入りのある管理簿を作成しています。
提出物として、マクロがかかっていない完成版のワークシートを別に保存する時、ワークシートをコピーしてから「名前を付けて保存」するやり方をしてます。でもなぜかその時日付が1日分だけ若く更新されるのです。
その他には、コピーさせずに移動でワークシートを切り離しても同じことが起こります。でも再びそのファイルに戻すと日付もまた元に戻ります。ちなみに日付には「3/4」という表示形式が選択されています。

この現象はずっと今まで気付かなかったんですが、これまでの提出用の完成版ファイルを確認したら全てそうなっていました。念のため、違うファイルの日付がある表でワークシートのコピーをしてみたんですが、この時は大丈夫でした。
どうやら、このマクロ入りの、それもファイルの種類が「Excel97および5.0/95ブック」のファイルだけがそうなるようです。

でも、複雑なマクロが組み込まれているので、ファイル自体を再作成して改めて上バージョンで保存させるのは大変です。周りの人に聞いてみたら、「多分97のバグだろう。MicrosoftのExcelバグ対応のページを見れば何かあるかも」と教えてもらったので見たんですが、数ある中でこの現象には何が対応してるのかさっぱり分かりません。

一応先月度の提出物は、ファイルを全コピーさせ、マクロ入りのいらないワークシートを全て削除する方法で作成しました。でもワークシートの数が多いしメモリも重い物なのでやっぱり少しやりにくいですね。毎月のことだのでもっと良いやり方にしたいものです。

長くなりましたが、どなたか正しい対応の仕方、また何故このような現象が起こるのか教えて下さい。

このQ&Aに関連する最新のQ&A

A 回答 (2件)

こんばんは!



>「1904」を外せば多分、元ファイルの日付のまま
>コピーされるんでしょうけど、そうすると元ファイル
>じたいの日付表示がおかしくなってしまうのなら、
>どうしようもありません。

「1904」を外すと既に入力された日付自体がコピー先と
同様に4年と1日ずれますので以下の方法で補正します。

・「1904」を外す
・適当なセルに1462と入力しそれをコピー
・日付の入っているセル範囲を選択
・右クリック 形式を選択して貼り付け [値]と[加算]をチェック
・OK
---------------
数値の 1462 は1900/1/1 と 1904/1/1 の経過日数
です(1904/1/1-1900/1/1+1)

試しに 新しいシートで[1904]にチェックした状態で
2001/1/1 と入力して[1904]のチェックを外し同作業を
行ってみて下さい!納得されると思います。

不便な機能と思われるかもしれませんが確かMAC版との
互換を保つためにあると聞いたことがあります。
あとこれを使うと時間のマイナス値も扱えるようになる
のですが、承知しての使い分けを行わないと、ご承知の
通り、不便を伴います。
    • good
    • 0
この回答へのお礼

comvさん、再びのアドバイスありがとうございます。
今教えていただいた通りやってみたら、みごと出来ました~。
「計算方法」に「1904」というチェック項目があり、2000年問題でそれにチェックされていると危ないと言われていたのを、今回をきっかけにして思い出しましたが、WinなのにMac版とのことでこんなに不便な機能があるなんて納得できないですよ。
まったくなんで4年も無駄に計算しなきゃいけないんでしょうね~(>_<)!

なんにしても、こんな複雑な管理簿を再作成しなくて済んで今はホッとしてます。
ホントにありがとうございました!

お礼日時:2001/12/07 10:21

こんにちは!



どちらかが(たぶん作成元)
ツール オプション 計算方法 [1904年から計算する]
にチェックが入っていると思います。

>でもなぜかその時日付が1日分だけ若く更新されるのです
正確には 4年と1日 小さくなります。

確認してみて下さい!

この回答への補足

comvさんアドバイスありがとうございます。
でもなんだか新たなトラブル発生で今ちょっとパニクってます。
comvさんの言うとおり、たしかにくだんのファイルの”計算方法”では設定が「1904」にチェックが入ってました。問題なのはそれを外すと、ワークシートをコピーしてからどころか、そのファイルそのものの日付まで4年と1日若く更新してしまいます。
「1904」を外せば多分、元ファイルの日付のままコピーされるんでしょうけど、そうすると元ファイルじたいの日付表示がおかしくなってしまうのなら、どうしようもありません。

・・・これはやはりファイルそのものを作成しなおさないといけないのでしょうか(T_T)

補足日時:2001/12/06 14:16
    • good
    • 0

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Q【Excel VBA】シートコピー時、マクロコードはコピーしたくない

ws.copy Before:=Workbooks(File).Sheets(1)
Windows(File).Activate
Cells.Select
Selection.copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

上記コードで、シートのコピー・貼付を行っていますが、
コピー元シートのコードも引き継がれてしまいます。
引き継がれないようにコピーしたいのですが、可能でしょうか?

可不可について、
可能ならばそのやり方(コード)を教えていただけないでしょうか?

よろしくお願いします。

Aベストアンサー

こんにちは

ご質問で求められている結果に対する理解が不充分かも知れませんが、
  シート(ws)のコピーを、ブック(file)Sheet1の直前に 挿入
  作成したシートの、数式の戻り値を 値に 直す
  シートモジュールのコピーを除いたコード、、、
というお話だと理解しました。


#2さんと殆ど同じなのですが、
元のシート(ws)の書式が新しいシートに反映されるようになってます。
コメントはコピーされますが、他のShapeは残りません。
もし、Shapeまでコピーするのでしたら、別途、ご質問されるとよいと思います。

#3も禁じ手と仰っていますが、
VBAのコードそのものを書き換える方法は、
それ以外に方法がない場合の非常手段だとしても、
余程パーソナルな用途でしか考えない方が良いです。
仕事で使うことが内規違反になる可能性もあるし、
使えない環境もありますので、
私も回答には書きたくないですね。

  ◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇

Sub TEST()
Const sFile As String = "ファイル名.xls" ' ※
Dim ws As Worksheet ' ※

  Application.ScreenUpdating = False ' ※

  Set ws = ThisWorkbook.Sheets(1) ' ※

  With Workbooks(sFile).Worksheets
  With .Add(Before:=.Item(1))

    ws.Cells.Copy .Cells

    .UsedRange.Value = .UsedRange.Value

    .Activate

  Application.ScreenUpdating = True ' ※
'    MsgBox "Done" ' ※
'    .Delete ' ※
  End With
  End With
End Sub

  ◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇
     ' ※ の行は、便宜的な記述です。


ご質問と関係ないことを書くことを、お許し下さい。
どうしても書いておきたいので、、、

Wendy02 さん
あなたがいないと、困ります。
出来れば、考え直して頂きたいけれど、
多く学ばせて頂いた一人として、感謝しています。
ありがとう ござい ます!!

こんにちは

ご質問で求められている結果に対する理解が不充分かも知れませんが、
  シート(ws)のコピーを、ブック(file)Sheet1の直前に 挿入
  作成したシートの、数式の戻り値を 値に 直す
  シートモジュールのコピーを除いたコード、、、
というお話だと理解しました。


#2さんと殆ど同じなのですが、
元のシート(ws)の書式が新しいシートに反映されるようになってます。
コメントはコピーされますが、他のShapeは残りません。
もし、Shapeまでコピーするのでしたら、別途、ご質問されるとよ...続きを読む

QExcel97で全シート検索のマクロを記述するには

住所録みたいな物である文字を全シートから半角,全角,大文字,小文字を区別する事なく曖昧検索し検索されたセルが有る一行に色を塗りつぶし、又次を検索したら一行に色を塗りつぶすようにするマクロを作成するにはどのようにしたらよいでしょうか?
もし色を塗り潰すのが大変な場合は検索されたセルが有る行を選択する事によって色が変わり検索結果がわかりやすくなるマクロを作成するにはどのようにしたらよいでしょうか?
以下マクロを教えていただき実行したのですが、ちゃんと色が付く時と、ダメな時「実行時エラー'1004': InteriorクラスのColorIndexプロパティを設定できません」とメッセージが出る時が有ります。
検索対象は各シート10~12列、全30シート計3500行くらいになります。
自分のPCはWinXP,CPU:3.06GHz,メモリ:1GHzですが
いろいろな機種みんなで使用したくCPU:1GHz,メモリ:256MBくらいでも使用出来たらと思います。宜しく御願いします。

Sub 検索color()
s = InputBox("検索文字列=")
If s = "" Then
Exit Sub
End If

Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
Set x = sh.Cells.Find(what:=s, MatchByte:=False)
If x Is Nothing Then GoTo p1
b = sh.Name & x.Address
sh.Activate
x.Activate

Rows(x.Row).Select
Selection.Interior.ColorIndex = 36
x.Select

'---

Do
Set y = sh.Cells.FindNext(after:=ActiveCell)
If y Is Nothing Then GoTo p1
If sh.Name & y.Address = b Then GoTo p1

y.Activate

Rows(y.Row).Select
Selection.Interior.ColorIndex = 36
y.Select

Loop
p1:
Next
End Sub

住所録みたいな物である文字を全シートから半角,全角,大文字,小文字を区別する事なく曖昧検索し検索されたセルが有る一行に色を塗りつぶし、又次を検索したら一行に色を塗りつぶすようにするマクロを作成するにはどのようにしたらよいでしょうか?
もし色を塗り潰すのが大変な場合は検索されたセルが有る行を選択する事によって色が変わり検索結果がわかりやすくなるマクロを作成するにはどのようにしたらよいでしょうか?
以下マクロを教えていただき実行したのですが、ちゃんと色が付く時と、ダメな時「実行時...続きを読む

Aベストアンサー

仕事が、忙しくなってきましたので、回答が遅れてしまいました。

プログラムの修正は、まだ、途中ですが
希望あれば、言ってください。
プログラムを完成させたいので、完成するまで、締切にしないでくだいい。


Sub 検索color()

Dim sh As Worksheet
Dim flt As AutoFilter

S = InputBox("検索文字列=")
If S = "" Then
Exit Sub
End If

sh_Name = ""

For Each sh In ActiveWorkbook.Worksheets

ActiveSheet.UsedRange.Select
hx = ActiveWindow.RangeSelection.EntireColumn.Count
Vy = ActiveWindow.RangeSelection.EntireRow.Count
Range("A1").Select

Set x = sh.Cells.Find(what:=S, MatchByte:=False)

If x Is Nothing Then GoTo p1

b = sh.Name & x.Address
If sh.Name <> sh_Name Then

sh_Name = sh.Name
sh.Activate

Columns("A:A").Offset(0, hx + 2).Select
Selection.ClearContents
For j = 1 To Vy
Range("A1").Offset(j - 1, hx + 2) = 0
Next j

Range("A1").Select
End If

sh.Activate
x.Activate

Rows(x.Row).Select
Range("A1").Offset(x.Row - 1, hx + 2) = 1
x.Select
Selection.Interior.ColorIndex = 36


Do
Set y = sh.Cells.FindNext(after:=ActiveCell)

If y Is Nothing Then Exit Do

If sh.Name & y.Address = b Then Exit Do

Rows(y.Row).Select
Range("A1").Offset(y.Row - 1, hx + 2) = 1
Rows(y.Row).Select
y.Activate
y.Select
Selection.Interior.ColorIndex = 36
Loop

Range("A1:B1").Offset(0, hx + 2).Select

Set flt = ActiveSheet.AutoFilter

If flt Is Nothing Then
Selection.AutoFilter
End If

Selection.AutoFilter Field:=1, Criteria1:="1"
Range("A1").Select

p1:
Next
End Sub

Sub 初期に戻す()

Dim sh As Worksheet
Dim flt As AutoFilter

sh_Name = ""


For Each sh In ActiveWorkbook.Worksheets


Set flt = ActiveSheet.AutoFilter

If flt Is Nothing Then
' 何もしない
Else
' AutoFilter を解除する
Selection.AutoFilter
End If

ActiveSheet.UsedRange.Select
hx = ActiveWindow.RangeSelection.EntireColumn.Count
Vy = ActiveWindow.RangeSelection.EntireRow.Count
Range("A1").Select


Cells.Select
Selection.Interior.ColorIndex = xlNone
Range("A1").Select

If sh.Name <> sh_Name Then
sh_Name = sh.Name
sh.Activate

Columns("A:A").Offset(0, hx - 1).Select
Selection.ClearContents
Range("A1").Select
End If


sh.Activate

Next


End Sub

仕事が、忙しくなってきましたので、回答が遅れてしまいました。

プログラムの修正は、まだ、途中ですが
希望あれば、言ってください。
プログラムを完成させたいので、完成するまで、締切にしないでくだいい。


Sub 検索color()

Dim sh As Worksheet
Dim flt As AutoFilter

S = InputBox("検索文字列=")
If S = "" Then
Exit Sub
End If

sh_Name = ""

For Each sh In ActiveWorkbook.Worksheets

ActiveSheet.UsedRange.Select
hx = ActiveWindow.RangeSe...続きを読む

Qエクセルのマクロでワークシートチェンジについてお教えください

以前教えていただいたマクロで
セルに入力があったら起動するマクロを作っています
・・・Private Sub Worksheet_Change(ByVal Target As Range)・・・

今回お聞きしたいのは
シート上にボタンを作っておいて
そのボタンを押すたびに
ワークシートチェンジ自体のマクロを発生する、しない
を切り替える 方法を教えていただきたいのです
 「発生している状態で作業をして
 ボタンを押して発生させなくして コピーをして
 別のシートに貼り付ける」というようなことをしたいのです
 (ワークシートチェンジが発生している状態だと
 コピーするための選択ができないので)

わかりにくい部分がありましたら
細くさせていただきますのでよろしくお願いいたします

Aベストアンサー

こんばんは。

----------------------------------------------

Private Sub CommandButton1_Click()

 Application.EnableEvents = Not Application.EnableEvents

 If Application.EnableEvents Then
   CommandButton1.Caption = "Event ON"
 Else
   CommandButton1.Caption = "Event OFF"
 End If

End Sub

----------------------------------------- 
IF文以下5行は必ずしも必要ありません。


●Wendy02さん、先日は色々ありがとうございました。
今回の件ですが、上記のコードでは拙いでしょうか。
 

QExcelで、フィルタ表示(マクロ使用)の結果を別シートにコピーした後・・・

|日付|開催地|英|米|仏|伊|独
|○日|神奈川|壱|壱|●|□|壱
|◎日|神奈川|●|壱|壱|□|□
|△日|神奈川|壱|壱|壱|□|●
|▲日|和歌山|壱|壱|壱|壱|●

このようなデータベース(表)があります。
1行目がタイトルで英~独はチーム名です。
チーム名欄には点数が入力されています。

 ※漢数字は普通の数字、”□”は空白に読み替えてください

ここで検索用シートにて、例えば開催地を
神奈川で検索すると

|日付|開催地|英|米|仏|伊|独
|○日|神奈川|壱|壱|●|□|壱
|◎日|神奈川|●|壱|壱|□|□
|△日|神奈川|壱|壱|壱|□|●

現在はこんな感じで検索結果が表示されます。

このとき検索結果と共に各チームの点数の合計を
検索結果が表示された最終行の次の行に計算させて
表示したいのですが、全ての点数を加算するのではなく
そのチームについている直近の●より
下の点数のみを合計して表示したいのです。


|日付|開催地|英|米|仏|伊|独
|○日|神奈川|壱|壱|●|□|壱
|◎日|神奈川|●|壱|壱|□|□
|△日|神奈川|壱|壱|壱|□|●
□□□□□□□□壱□参□弐□□□零 ←こんな風に

英は、◎日において●が付いているので合計点は1点。
伊は、神奈川においては得点がないので空白とする。
独は、抽出された最終日において●なので点数は0点となる。

更にこの状態から得点のないチームを除きたい。
ただし、伊は除外するが、独は0点では
あるものの点数はあると考えて残す。

|日付|開催地|英|米|仏|独
|○日|神奈川|壱|壱|●|壱
|◎日|神奈川|●|壱|壱|□
|△日|神奈川|壱|壱|壱|●
□□□□□□□□壱□参□弐□零

↑最終的にこのような形で表示したいのですが
どのように処理すればよいでしょうか。

|日付|開催地|英|米|仏|伊|独
|○日|神奈川|壱|壱|●|□|壱
|◎日|神奈川|●|壱|壱|□|□
|△日|神奈川|壱|壱|壱|□|●
|▲日|和歌山|壱|壱|壱|壱|●

このようなデータベース(表)があります。
1行目がタイトルで英~独はチーム名です。
チーム名欄には点数が入力されています。

 ※漢数字は普通の数字、”□”は空白に読み替えてください

ここで検索用シートにて、例えば開催地を
神奈川で検索すると

|日付|開催地|英|米|仏|伊|独
|○日|神奈川|壱|壱|●|□...続きを読む

Aベストアンサー

#1です。

何処で止まるのか、どんなメッセージで止まるのかを書けばある程度は推測出来ますが、、、
VBAヘルプがインストール済みならば、解らない部分にカーソルを入れて F1キーを押すとヘルプが表示されます。
VBAヘルプが未インストールなら OfficeのCDから追加インストールします。

例) Offset が解らないなら、Offsetという単語の中にカーソルを入れて F1キーを押下

またVBE画面とExcel画面を並べて表示し、VBEメニューのデバック-ステップ実行にして F8キーを押下していくと実行する様子や変数の状況などを確認出来ます。(私が提示したサンプルは殆ど動きがないですが、、、)

Sub Test()
'変数宣言
Dim myCol As Integer, myVal
Dim LRow As Long, myRow As Long

'アクティブシートに対して
With ActiveSheet
 'A列の最終行+1の行番号を保持(合計を入れる行とする)
 LRow = .Cells(65536, 1).End(xlUp).Offset(1, 0).Row
 'タイトル行(1行目)の最終列を探し、最終列から3列目までループ
 '右から左に処理をするのは列を削除する可能性があるため
 For myCol = .Range("IV1").End(xlToLeft).Column To 3 Step -1
   '変数初期化
   myVal = 0
   '対象列の最終行番号を取得
   myRow = .Cells(65536, myCol).End(xlUp).Row
   '対象列の最終行番号が1ならばタイトルのみと判断し列を削除
   If myRow = 1 Then
    .Columns(myCol).Delete
   Else
    '対象列の最終行番号が1じゃない場合
    '最終行から上にループ(変数myRowが1より大か、●じゃないなら)
    Do While myRow > 1 And .Cells(myRow, myCol).Value <> "●"
      'セルの値を足す
      myVal = myVal + .Cells(myRow, myCol).Value
      '変数を減らす(上にループするため)
      myRow = myRow - 1
    Loop
    'ループを抜けたら結果を合計行に代入
    .Cells(LRow, myCol) = myVal
   End If
 '次の列へ
 Next myCol
End With
End Sub

#1です。

何処で止まるのか、どんなメッセージで止まるのかを書けばある程度は推測出来ますが、、、
VBAヘルプがインストール済みならば、解らない部分にカーソルを入れて F1キーを押すとヘルプが表示されます。
VBAヘルプが未インストールなら OfficeのCDから追加インストールします。

例) Offset が解らないなら、Offsetという単語の中にカーソルを入れて F1キーを押下

またVBE画面とExcel画面を並べて表示し、VBEメニューのデバック-ステップ実行にして F8キーを押下していくと実行する様子や変...続きを読む

Qマクロで別ファイルのシートコピーして、元ファイルに貼り付けを行なうには

VBA初心者です。こんなマクロを作りたいのですが・・・
(1) Aファイルのαシートから操作する。
(2) Bファイルを開いて、βシートの一部をコピー
(3) Bファイルを閉じる(保存なし・各種アラートなし)
(4) Aファイルに再び戻り、αシートに貼り付けする

といったものなのですが、
(2)まではできたのですが、(3)からうまくいかず、勝手に新規ファイルにβシートがコピーされてしまいます。
是非ご教授ください。

Aベストアンサー

A No.1とかぶっちゃいましたが、サービスでコード付ということで投稿させていただきます。
(1) Aファイル(マクロを記述してある)から操作する。
(2) Bファイルを開く
(3) Bファイルのβシートの一部をコピーして、Aファイルのαシートに貼り付けする
(4) Bファイルを閉じる(保存なし・各種アラートなし)
というワークフローにすれば、
(3)は、
Sub test()
Workbooks("Bファイル.xls").Sheets("β").Range("A1:B4").Copy ThisWorkbook.Sheets("α").Range("a1")
End Sub
で実現できます。(複写先範囲は適当にいじって下さい)


人気Q&Aランキング

おすすめ情報