エクセルのマクロ式が消えてしまったので再度作成しました。

日本に長期一時帰国中のオイラです。

家の中にいる場所は夕方くらいからは2階です。

ここに古いPCを置いています。

日中は1階の南側の部屋にいます。

こちらには去年買ったPCを置いています。

ファイルの管理はグーグルのドライブかDropboxで行っています。

これにより1階のPCでも2階のPCでも同じファイルにアクセスできます。

2階にある古いPCにはoffice365が入っていたのですが去年の何月か忘れましたが

この365を使おうとしたら期限がきれたのでコードを入力して下さいというような

メッセージが表示され使えなくなった。

コードを再入力すれば使えるようだがそのコードが書いてある紙が見つからない。

たぶんタイのアパートに置いてきたのだろう。

このままでは2階のPCではエクセルが使えないので何かないかと探してみた。

こんなのが出てきました。

使えそうなので使ってみたがエクセルに入れてあるマクロが動かなくなってしまった。

マクロ式を読むとフリーソフトでは読み込めないマクロ式があるような感じです。

マクロ無しでもエクセルは使っていけますが

毎日使っているエクセルなので何とかマクロが使えるように

1階にあるPCを使って挑戦してみました。

Dimを使うマクロなので作っていくのが難しいかった。

マクロを勉強している人には簡単だろうがオイラはほぼ独学なので難しかった。

何とか1日で完成した。

このブログに式を残しておけば今回のように必要になった時直ぐに使えるので

転ばぬ先の杖ではないが転んだとき用にその式をここに張付けておく。

Sub 一行足し()

'

' 一行足し Macro

' マクロ編集用 Macro

 'Sub CからSまで数式をコピー()

'

' 数式をコピー

' 再表示 Macro

'(前準備)

    Application.ScreenUpdating = False

    Columns("B:AC").Select

    Selection.EntireColumn.Hidden = False

    Range("B1").Activate

    Selection.End(xlDown).Select

'日付の横の列の書いてある最終セルを選択

   Dim Range1, 行1 As Range

   'Set 行1 = Range("C1")

   Set Range1 = Range("C1").End(xlDown)

   Set 行1 = Range1.Offset(0, 0)

   Dim Range2, 行2 As Range

   Set Range2 = Range("X1").End(xlDown)

   Set 行2 = Range2.Offset(0, 23)

   Range(行1, 行2).Select

   

 '数式をコピー

   Selection.Copy

   

 '数式を貼付るセルを選択

    Dim Range3, 行3 As Range

   Set 行3 = Range1.Offset(1, 0)

   Dim Range4, 行4 As Range

   Set 行4 = Range1.Offset(1, 0)

   Range(行3, 行4).Select

   

   ActiveSheet.Paste

   

   Range("B2").Select

Application.ScreenUpdating = True

 Application.CutCopyMode = False

 

 '日付用

 Range("B1").Select

    Selection.End(xlDown).Select

    

    'Dimを使う

    Dim Range5, 行5 As Range

   Set 行5 = Range("B1")

   Set Range5 = Range("B1").End(xlDown)

   Set 行5 = Range5.Offset(0, 1)

   'Dim Range2, 行2 As Range

  ' Set Range2 = Range("C1").End(xlDown)

  ' Set 行2 = Range2.Offset(0, 23)

'数式をコピー

   Selection.Copy

  '数式を貼付るセルを選択

  ActiveCell.Offset(1#).Select

   '日付1日プラスする式

   ActiveCell.FormulaR1C1 = "=R[-1]C+1"

    'Range("B1138").Select

    Selection.Copy

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

  

    Dim Range6, 行6 As Range

'   Set 行6 = Range6

  ' Set 行6 = Range6.Offset(1, 0)

    'Dim Range4, 行4 As Range

   'Set 行4 = Range1.Offset(0, 1)

   'ActiveCell.Offset(1.0)Select

   ' Range(行6).Select

'   ActiveSheet.Paste

 '  Range("B2").Select

End Sub

赤字は不要ですが作成途中試した式ですので残しておきました。

頭に「'」があるので実際のマクロ実行時には関係ありません。

一番最後の「 Dim Range6, 行6 As Range」も要らないと思う。