- ベストアンサー
エクセルマクロでセルに移動する方法
- エクセルのマクロで行を挿入し、前行の数式をコピーする方法を教えてください。
- 特定のセルにカーソルを移動するために、マクロの最後にどのような変更をすれば良いですか？
- エクセルのマクロを使って、セルへの移動を行いたいと思っています。具体的な方法を教えてください。
- みんなの回答 （18）
- 専門家の回答
質問者が選んだベストアンサー
こんばんわ。早速修正マクロを作ってみました。次の手順で操作してみて下さい。 １.前回マクロを貼り付けたブックを立ち上げる。 ２.Sheet1モジュールシートを開き、コードをすべて削除した後、下記のコードをコピー・ペーストする。 Private Sub Worksheet_Activate() Call Module1.myCell_Select End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim myRow As Long Dim myCnt As Integer Dim i As Integer Dim myMsb As Integer Dim myCell1 As String Dim myCell2 As String myRow = Target.Row myCnt = Cells(1, Columns.Count).Column For i = 1 To myCnt If Target.Address = Cells(myRow, i).Address Then Exit Sub Next i If Range("A" & myRow).Value = "" Then Exit Sub myMsb = MsgBox("削除処理を実行してもよろしいですか？", vbYesNo + vbQuestion, "作 業 確 認") If myMsb = vbNo Then End Application.EnableEvents = False Target.Delete shift:=xlShiftUp Application.EnableEvents = True If myRow = 2 And Range("A" & myRow).Value = "" Then Exit Sub If Cells(Rows.Count, 7).End(xlUp).Offset(0, -6).Value = "" Then Application.EnableEvents = False Cells(Rows.Count, 7).End(xlUp).Value = "" Cells(Rows.Count, 8).End(xlUp).Value = "" Application.EnableEvents = True End If Application.EnableEvents = False Call Module1.myCalculation(myRow) Application.EnableEvents = True End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim myRow As Long Dim myColumn As Integer Dim myRange As Range myRow = Target.Row If myRow = 1 Then Exit Sub myColumn = Target.Column Select Case myColumn Case 1, 6, 7 If Target.Address = Range("A" & myRow).Address Then If myRow = 1 Or myRow = 2 Then Exit Sub If Range("A" & myRow).Value <> "" Then If Target.Value = Target.Offset(-1, 0).Value Then If Target.Offset(1, 0).Value <> "" Then Rows(myRow + 1 & ":" & myRow + 1).Insert shift:=xlShiftDown End If Else Rows(myRow & ":" & myRow).Insert shift:=xlShiftDown End If If Cells(Rows.Count, 1).End(xlUp).Row < Cells(Rows.Count, 7).End(xlUp).Row Then Application.EnableEvents = False Cells(Rows.Count, 7).End(xlUp).Value = "" Cells(Rows.Count, 8).End(xlUp).Value = "" Application.EnableEvents = True End If End If Application.EnableEvents = False Call Module1.myCell_Select Application.EnableEvents = True End ElseIf Target.Address = Range("F" & myRow).Address Then If myRow = 1 Then Exit Sub If Range("A" & myRow).Value = "" Then Exit Sub Application.EnableEvents = False If Target.Offset(0, 1).Value = "" Then Range("G" & myRow).Select Application.EnableEvents = True End Else If Target.Value = "" Then Target.Offset(0, 2).Value = Target.Offset(0, 1).Value * 0.75 Else Target.Offset(0, 2).Value = Target.Offset(0, 1).Value End If End If Application.EnableEvents = True ElseIf Target.Address = Range("G" & myRow).Address Then If myRow = 1 Then Exit Sub If Range("A" & myRow).Value = "" Then Exit Sub Application.EnableEvents = False If Target.Offset(0, -1).Value = "" Then Target.Offset(0, 1).Value = Target.Value * 0.75 Else Target.Offset(0, 1).Value = Target.Value End If Application.EnableEvents = True End If Application.EnableEvents = False Call Module1.myCalculation(myRow) Range("A" & myRow + 1).Select Application.EnableEvents = True End Select End Sub また、不都合なことがありましたら、お知らせ下さい。
その他の回答 (17)
- kazuhiko5681
- ベストアンサー率49% (79/159)
こんばんは。コマンドボタンは、次のように操作して出します。 また、コマンドボタンを配置するだけでimogasiさんのマクロは動きます。 ・ファイルメニューにマウスポインターをあわせて右クリックし、出てき たプルダウンメニューのVisual Basicをクリックする。 ・出てきたツールバーの右から３番目(コントロールツールボックス)をク リックし、コントロールツールボックスの一番右側の上から２番のコマ ンドボタンをクリックし、シートの適当な位置でクリックする。 ・ツールバーの２番目(デザインモード)のボタンが押された状態になって いたらそのボタンをクリックしてＯＦＦの状態にする。 この状態にしてボタンをクリックしてみて下さい。動作します。
お礼
お礼が大変遅くなり申し訳ありませんでした。 おかげさまでマクロの動作を確認できました。 長い間、面倒を見ていただいて本当ありがとうございました。 また、宜しくお願い致します。
- imogasi
- ベストアンサー率27% (4737/17069)
＃１４のものです。私の回答に#16で言及があったので。 （１）私のはエベントを捉えているので、挿入モードと非挿入 モードを分けないと、他の操作に差し支えるのであのようにしました。 ＃５はそういう方向ではない。 （２）Changeエベントを使っている。 ＃５はそういう方向ではない。 （３）基本的に挿入の部分のコードは誰が書いても似たも のになると思いますが。 （４）＞「G2に入れた数式をG3へコピーすると数式の選択セル も変更されてしまう」 これは本質問が、コピー後コピー元とコピー先が全く変更し ないと言う条件付きであるとは、解せませんでした。 また問題にされる意味が判りません。 （５）私が＃１４を載せようと思ったのは、回答文が長く（私 のも（１）のために長くなっており済みません）質問者の理 解や読持続力を超えているのではと思ったためでした。 しかし私もどんどん増やしているので、済みません。
補足
こんにちは。 PC環境から離れていたため、ご連絡が遅くなりましたことをお詫びいたします。 #15にて補足いただいたのですが・・・ 恥ずかしながら、マクロを確認する前の段階で つまずいております。 ＞（１）ボタンは、ＶＢのツールバーのコマンドボタン＞をワークシートにドロップアンドドロップして、貼り＞付けます。 「ＶＢのツールバーのコマンドボタン」 これが何処にあるのかがわからないでおります。 また、このボタンをドロップアンドドロップするだけで、sheet１をダブルクリックして作っていただいたコードを記載したマクロがボタンに割り当てられるものなのでしょうか？ 超超未熟者でお話にならないとお思いでしょうが、 お許し頂きたくm(__)m
- kazuhiko5681
- ベストアンサー率49% (79/159)
こんばんわ。皆様に喜んでいただけて私も作った甲斐があります。何度も修正にお手数をおかけして時間がかかり、申し訳ございませんでした。 おせっかいかもしれませんが、＃１４imogasiさんの作られたマクロは、私が＃５でご紹介したサンプルマクロと同じ内容のものです。 imogasiさんのマクロを実行すると、G2に入れた数式をG3へコピーすると数式の選択セルも変更されてしまうという問題が生じると思います。 老婆心ながら、生意気なことを書かせていただきました。ご無礼をお許し下さい。
- imogasi
- ベストアンサー率27% (4737/17069)
＃４のものです。補足要求に対し、補足します。 （１）ボタンは、ＶＢのツールバーのコマンドボタンをワークシートにドロップアンドドロップして、貼り付けます。 ＶＢのＦｏｒｍ１のようにＦｏｒｍを持ってくる必要はありません。邪魔です。シートがコントロールの台帳的役割をします。ＶＢはＦｏｒｍが必須ですが、エクセルはワークシートに 貼り付けられます。データの邪魔にならないところに貼り付けてください。 （２）ボタンのＣａｐｔｉｏｎは、初期状態として、プロパティ画面等で「挿入」とすべきですが、１回クリックすると「挿入」になるので省略しました。 （３）（Ａ）ボタンはＳｈｅｅｔ１上の貼り付けられたコントロール（Ｂ）Selection_ChangeはＳｈｅｅｔ１のイベントなので、プロジェクトのＳｈｅｅｔ１をダブルクリックして出てくる画面に、両方とも貼り付けて下さい。 （４）マクロの記録をボタンに登録するのは（任意の時に）簡単に起動するために象徴化するのですが、（Ａ）本件のコマンドボタンの押し下げ（Ｂ）Ｓｈｅｅｔ１のＳｅｌｅｃｔの変化を契機とする（プログラムの１部の実行の契機となる）もので 同列には論ぜられません。Ａがないと、Ｂはシートを開くと常時待機体制になります。それを常時行われないように、安全装置として、非挿入モードを作っているわけです。
補足
回答をありがとうござました。 私の質問に沢山の検討をいていただいて感謝しています。 ＃5との同、異など少し理解をすることに時間を必要とするため暫くのお時間ください！ 皆様のお手数を少しでも無駄にしたくないので・・・
- imogasi
- ベストアンサー率27% (4737/17069)
＜もっと簡単に出来るのではないか＞ #3で補足要求を入れたものです。質問を理解して頂けなくて 残念でした。それは良いのです。しかし他のご解答のたびに 解答が入りますので、読んでいました。しかし膨大な補足と 解答を読解できる力がありませんで失礼しますが,こんなに 長くなるのと思い、 「エクセルで行を挿入し前行の数式をコピーする」事を短く 実現を目指しました。 ●＜操作＞ （１）Sheet1にボタンを１つ貼り付ける。「非挿入」と「挿入」はクリックで反転する。必ず「挿入」の表示にして、コピー元のセルをクリックする。 （２）クリックした行の直下行に１行自動的に挿入し、挿入した行に、クリックした行をコピーします。 （３）操作後は挿入行をＳｅｌｅｃｔ状態ですが 任意のセルをＳｅｌｅｃｔ状態にする。 クリックしたセルの直下セルをＳｅｌｅｃｔ状態に することは簡単ですが省略します。 （４）［非挿入」には自動的にします。 （５）コピー元以外にカーソルを一旦置いて、挿入状態にして、挿入行をクリックして貰ったほうが良い。 ●＜コード＞ ボタンについては、ＶＢＥのSheet1のコード面に Private Sub CommandButton1_Click() If CommandButton1.Caption = "挿入" Then CommandButton1.Caption = "非挿入" Else CommandButton1.Caption = "挿入" End If End Sub ＝＝＝＝＝＝ 同じくSheet1のコードの画面に Private Sub Worksheet_SelectionChange(ByVal Target As Range) If CommandButton1.Caption = "挿入" Then r = Target.Row: c = Target.Column Worksheets("sheet1").Cells(r + 1, c).EntireRow.Insert CommandButton1.Caption = "非挿入" Rows(r).Copy Rows(r + 1).Select ActiveSheet.Paste Application.CutCopyMode = False '----- Else Exit Sub End If End Sub を貼り付けてください。 ●テストする時は、「元に戻す」が効きませんので、必ずコピー したシートで行ってください。
補足
回答をありがとうございました。 作成していただいたマクロのテストを試みたいと思っているのですが, 大変申し訳ないことに、手順が良くわかりません。 >（１）Sheet1にボタンを１つ貼り付ける。 ボタンはフォームで作成すればよろしいのですよね？ テキストの編集は必要ないですか？（ボタン１のまま） >●＜コード＞ >ボタンについては、ＶＢＥのSheet1のコード面に >同じくSheet1のコードの画面に ＶＢＥのＳｈｅｅｔ１（コード）の面に２種類を連記で良いのですよね？ フォームでボタンに作成していただいたマクロを登録するのでしょうか？ マクロの記録で作成したマクロをボタンに登録する方法とは違っているように思われるのですが、登録の手順がわかりません… お手数とは思いますが手順方法を詳しく教えていただけるでしょうか。 宜しくお願いいたします。
- kazuhiko5681
- ベストアンサー率49% (79/159)
こんにちは。 修正するのはよろしいのですが、どの様に修正するのか教えて下さい。以上の点がわからないと、修正プログラムを書くことができません。
補足
こんばんは。 またも、説明不足ですみませんm(__)m 区分（F列）へのデータ入力が有る場合、確定でTABキーまたは→を使用しても選択セルが日付（Ａ列）へ移動するのですが、続けて金額を入力したいので選択セルは価格（G列）へ移動するようにお願いしたいと思います。 宜しくお願いいたします。
- kazuhiko5681
- ベストアンサー率49% (79/159)
こんばんわ。少し手間を取ってしまいましたが、サンプルマクロを作り上げることができました。初期入力・追加入力・行削除を実行後、自動で再計算できるように作りました。また、価格と実価格それぞれの合計も最終行の２行下へ自動計算で値を出力できるように作りました。ただし、行削除を実行するときは、必ず行番号をクリックし、行全体を選択するようにしてください。 １.ＶＢＥ画面左上のSheet1の上で右クリック→挿入→標準モジュールをクリック ２.画面右側の白い部分に下のコードをコピー・ペーストする。 Sub myCalculation(myRow As Long) Dim myCell1 As String Dim myCell2 As String Dim mySum1 As Long Dim mySum2 As Long If Range("A" & myRow).Value = "" Then If Range("A" & myRow - 2).Value = "" Or myRow = 3 Then Range("I" & myRow - 1).Value = Range("H" & myRow - 1).Value Else myCell2 = Range("H" & myRow).End(xlUp).Address myCell1 = Range(myCell2).End(xlUp).Address Range("I" & myRow - 1).Value = "" Range(myCell2).Offset(0, 1).Value = Application.WorksheetFunction.Sum(Range(myCell1 & ":" & myCell2)) End If Else If Range("A" & myRow - 1).Value = "" Or myRow = 2 Then If Range("A" & myRow + 1).Value = "" Then Range("I" & myRow).Value = Range("H" & myRow).Value Else myCell1 = Range("H" & myRow).Address myCell2 = Range(myCell1).End(xlDown).Address Range("I" & myRow - 1).Value = "" Range(myCell2).Offset(0, 1).Value = Application.WorksheetFunction.Sum(Range(myCell1 & ":" & myCell2)) End If ElseIf Range("A" & myRow - 1).Value <> "" Then If Range("A" & myRow + 1) = "" Then myCell2 = Range("H" & myRow).Address myCell1 = Range(myCell2).End(xlUp).Address Else myCell1 = Range("H" & myRow).End(xlUp).Address myCell2 = Range("H" & myRow).End(xlDown).Address End If Range("I" & myRow - 1).Value = "" Range(myCell2).Offset(0, 1).Value = Application.WorksheetFunction.Sum(Range(myCell1 & ":" & myCell2)) End If End If myCell1 = Cells(Rows.Count, 1).End(xlUp).Offset(0, 6).Address myCell2 = Cells(Rows.Count, 1).End(xlUp).Offset(0, 7).Address Range(myCell1).Offset(2, 0).Value = Application.WorksheetFunction.Sum(Range("G2:" & myCell1)) Range(myCell2).Offset(2, 0).Value = Application.WorksheetFunction.Sum(Range("H2:" & myCell2)) End Sub Sub myCell_Select() Dim myRow As Long Dim myColumn As Integer myRow = Cells(Rows.Count, 1).End(xlUp).Row myColumn = Cells(1, Columns.Count).Column myColumn = Cells(myRow, myColumn).End(xlToLeft).Column Select Case myColumn Case 1 Cells(myRow, 2).Select Case 2 Cells(myRow, 3).Select Case 3 Cells(myRow, 4).Select Case 4 Cells(myRow, 5).Select Case 5 Cells(myRow, 6).Select Case 6 Cells(myRow, 7).Select Case Else Cells(myRow + 1, 1).Select End Select End Sub ３.Sheet1のモジュールシートに、下のコードをコピー・ペストする。 Private Sub Worksheet_Activate() Call Module1.myCell_Select End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim myRow As Long Dim myCnt As Integer Dim i As Integer Dim myMsb As Integer Dim myCell1 As String Dim myCell2 As String myRow = Target.Row myCnt = Cells(1, Columns.Count).Column For i = 1 To myCnt If Target.Address = Cells(myRow, i).Address Then Exit Sub Next i If Range("A" & myRow).Value = "" Then Exit Sub myMsb = MsgBox("削除処理を実行してもよろしいですか？", vbYesNo + vbQuestion, "作 業 確 認") If myMsb = vbNo Then End Application.EnableEvents = False Target.Delete shift:=xlShiftUp Application.EnableEvents = True If myRow = 2 And Range("A" & myRow).Value = "" Then Exit Sub If Cells(Rows.Count, 7).End(xlUp).Offset(0, -6).Value = "" Then Application.EnableEvents = False Cells(Rows.Count, 7).End(xlUp).Value = "" Cells(Rows.Count, 8).End(xlUp).Value = "" Application.EnableEvents = True End If Application.EnableEvents = False Call Module1.myCalculation(myRow) Application.EnableEvents = True End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim myRow As Long Dim myColumn As Integer Dim myRange As Range myRow = Target.Row If myRow = 1 Then Exit Sub myColumn = Target.Column Select Case myColumn Case 1, 6, 7 If Target.Address = Range("A" & myRow).Address Then If myRow = 1 Or myRow = 2 Then Exit Sub If Range("A" & myRow).Value <> "" Then If Target.Value = Target.Offset(-1, 0).Value Then If Target.Offset(1, 0).Value <> "" Then Rows(myRow + 1 & ":" & myRow + 1).Insert shift:=xlShiftDown End If Else Rows(myRow & ":" & myRow).Insert shift:=xlShiftDown End If If Cells(Rows.Count, 1).End(xlUp).Row < Cells(Rows.Count, 7).End(xlUp).Row Then Application.EnableEvents = False Cells(Rows.Count, 7).End(xlUp).Value = "" Cells(Rows.Count, 8).End(xlUp).Value = "" Application.EnableEvents = True End If End If Application.EnableEvents = False Call Module1.myCell_Select Application.EnableEvents = True End ElseIf Target.Address = Range("F" & myRow).Address Then If myRow = 1 Then Exit Sub If Range("A" & myRow).Value = "" Then Exit Sub Application.EnableEvents = False If Target.Offset(0, 1).Value <> "" Then If Target.Value = "" Then Target.Offset(0, 2).Value = Target.Offset(0, 1).Value * 0.75 Else Target.Offset(0, 2).Value = Target.Offset(0, 1).Value End If End If Application.EnableEvents = True ElseIf Target.Address = Range("G" & myRow).Address Then If myRow = 1 Then Exit Sub If Range("A" & myRow).Value = "" Then Exit Sub Application.EnableEvents = False If Target.Offset(0, -1).Value = "" Then Target.Offset(0, 1).Value = Target.Value * 0.75 Else Target.Offset(0, 1).Value = Target.Value End If Application.EnableEvents = True End If Application.EnableEvents = False Call Module1.myCalculation(myRow) Call Module1.myCell_Select Application.EnableEvents = True End Select End Sub ４.ThisWorkbookのモジュールシートに下のコードをコピーペーストする。 Private Sub Workbook_Open() Call Module1.myCell_Select End Sub もし、不都合なことがありましたらお知らせ下さい。
補足
サンプルマクロをありがとうございました。 たびたびのお手間、貴重なお時間を使っていただいていることに本当に感謝しています。 マクロの確認をさせていただきました。 気づいた箇所が1点あり、修正のお願いができるかと思いご連絡いたします。 データを入力し、区分（F列）へデータを入力し確定すると、選択セルが日付（Ａ列）へ移動してしまうようです。区分（Ｆ列）へのデータ入力が無い場合は問題ないようです。 自分で修正できればと思いましたが、今の私にはもう何が何だか・・・^_^; お手数かとは思いますが、修正をお願いできるでしょうか？ 宜しくお願い致します。
- kazuhiko5681
- ベストアンサー率49% (79/159)
こんばんわ。あなた様が作られている表構成を確認するために、サンプルマクロを作りました。 前回と同じように新規ブックを開き、Sheet1のモジュールシートに下記のコードを貼り付け、データー入力してみて下さい。一度入力して自動計算をした値は「区分」の有無を変更した時に自動計算できるように訂正してあります。 もし、この表構成でよろしければ次のことをお知らせ下さい。完全なサンプルマクロを作りたいと思います。 １.今回は空白行を設けましたが、この行にデータを入力することがあるかどうか。もし、あるとしたらどのようなデータを入力するのか。 ２.１行すべてを削除することがあるのかどうか。また、その時合計の自動計算が必要かどうか。 ３.その他気がついた点で、修正してほしい内容 Private Sub Worksheet_Change(ByVal Target As Range) Dim myRow As Long Dim myCell1 As String Dim myCell2 As String Dim myRange As Range myRow = Target.Row If Target.Address = Range("A" & myRow).Address Then If myRow = 1 Or myRow = 2 Then Exit Sub If Target.Value <> "" Then If Target.Value <> Target.Offset(-1, 0).Value Then Rows(myRow & ":" & myRow).Insert Shift:=xlShiftDown If Target.Address = "$A$4" Then Target.Offset(-1, 6).Value = Range("F2").Value Else myCell1 = Target.Offset(0, 6).End(xlUp).Offset(1, -1).Address myCell2 = Target.Offset(-1, 5).Address Target.Offset(-2, 6).Value = Application.WorksheetFunction.Sum(Range(myCell1 & ":" & myCell2)) End If End If Target.Offset(0, 1).Select End If ElseIf Target.Address = Range("D" & myRow).Address _ Or Target.Address = Range("E" & myRow).Address Then If myRow = 1 Then Exit Sub If Target.Column = 4 And Target.Offset(0, 1).Value <> "" Then If Target.Value = "" Then Target.Offset(0, 2).Value = Target.Offset(0, 1).Value * 0.75 Else Target.Offset(0, 2).Value = Target.Offset(0, 1).Value End If If Target.Offset(0, 3).End(xlDown).Address <> Cells(Rows.Count, 7).Address Then If Target.Offset(-1, 2).Value = "" Then myCell1 = Target.Offset(0, 2).Address Else myCell1 = Target.Offset(0, 2).End(xlUp).Address End If myCell2 = Range(myCell1).End(xlDown).Address Target.Offset(0, 3).End(xlDown).Value = Application.WorksheetFunction.Sum(Range(myCell1 & ":" & myCell2)) End If ElseIf Target.Column = 5 Then If Target.Offset(0, -1).Value = "" Then Target.Offset(0, 1).Value = Target.Value * 0.75 Else Target.Offset(0, 1).Value = Target.Value End If If Target.Offset(0, 2).End(xlDown).Address <> Cells(Rows.Count, 7).Address Then If Target.Offset(-1, 1).Value = "" Then myCell1 = Target.Offset(0, 1).Address Else myCell1 = Target.Offset(0, 1).End(xlUp).Address End If myCell2 = Range(myCell1).End(xlDown).Address Target.Offset(0, 2).End(xlDown).Value = Application.WorksheetFunction.Sum(Range(myCell1 & ":" & myCell2)) End If End If Set myRange = Cells(Rows.Count, 1).End(xlUp) If myRange.Offset(0, 1).Value = "" Then myRange.Offset(0, 1).Select ElseIf myRange.Offset(0, 5).Value <> "" Then myRange.Offset(1, 0).Select Else myRange.End(xlToRight).Offset(0, 1).Select End If End If End Sub お手数をおかけいたしますが、よろしくお願いいたします。
補足
たびたびのお手間、感謝しています。 頂いたサンプルマクロを確認させていただきました。 設けて頂いた日付が変わった際の空白行へは、通常ではデータを入力することはありません。 ですが、入力漏れがあった際に行を挿入等してデータを追加する場合はあるかと思います。 1.その際、日別の小計を再計算させ日別の最終行へ表示することは可能でしょうか？ また、削除した際の日別小計の再計算表示も可能でしょうか？ 1行を全て削除、または範囲を指定して複数行を削除することも考えられます。 価格と実価格の合計を入力済みデータの最終行より２、3行下に表示したいのですが、現行では入力データが増えて合計を出してある欄に迫ってきたところで再度セルを移動しＳＵＭの再計算をしています。 2.マクロで、常に最終行後に表示し再計算するようになりますか？ 今回頂いた、サンプルマクロで気が付いた点としては、 最初に入力するデータが１行のみであった場合、 日別小計が次行のスペースの行へ表示されるようです。 お言葉に甘えまして、またマクロの作成を依頼できるのでしたら、甘えついでにお願いをしても良いでしょうか… 区分の前に２行項目を増やしていただけますか。 増えた列はデータの入力だけで、計算はありません。 よって、Ｄ列（区分）→Ｆ列、Ｅ列（価格）→Ｇ列、 Ｆ列（実価格）→Ｈ列、Ｇ列（日別小計）→Ｉ列 と変更したいのですが… 前回のマクロはマニュアル片手に何とか変更させたので、お手数なようでしたら、現行のままでも結構です。 いろいろと勝手なお願いで申し訳ありませんが、宜しくお願いします。
- kazuhiko5681
- ベストアンサー率49% (79/159)
私の考えで、マクロを作ってみました。 まず最初に、前回と同じ方法で、下記のコードを新規ブックのSheet1モジュールにコピー・ペーストして下さい。 Private Sub Worksheet_Activate() Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim myCell1 As String Dim myCell2 As String If Target.Column = 1 Then If Target.Address = "$A$1" Or Target.Address = "$A$2" Then Exit Sub Else If Target.Value = Target.Offset(-1, 0).Value Then Target.Offset(-1, 6).Value = "" Target.Offset(0, 6).Value = "" Else If Target.Offset(-1, 0).Value <> Target.Value Then If Target.Address = "$A$3" Then Target.Offset(-1, 6).Value = Range("F2").Value Else myCell1 = Target.Offset(0, 6).End(xlUp).Offset(1, -1).Address myCell2 = Target.Offset(-1, 5).Address Target.Offset(-1, 6).Value = Application.WorksheetFunction.Sum(Range(myCell1 & ":" & myCell2)) End If End If End If End If ElseIf Target.Column = 5 Then If Target.Value = "" Then Target.Offset(0, 1).Value = "" Target.Offset(0, 2).Value = "" Else If Target.Offset(0, -1).Value = "" Then Target.Offset(0, 1).Value = Target.Value * 0.75 Else Target.Offset(0, 1).Value = Target.Value End If If Target.Offset(1, -4).Value <> "" Then If Target.Offset(1, -4).Value <> Target.Offset(0, -4).Value Then myCell1 = Application.WorksheetFunction.Sum(Range("F2:" & Target.Offset(0, 1).Address)) myCell2 = Application.WorksheetFunction.Sum(Range("G2:" & Target.Offset(-1, 2).Address)) Target.Offset(0, 2).Value = myCell1 - myCell2 End If End If Target.Offset(1, -4).Select End If End If End Sub 今度は、ＶＢＥ画面の左上のThisWorkbookをダブルクリックし、ThisWorkbookのモジュールを開きます。そのモジュールに以下のコードをコピーペーストして下さい。 Private Sub Workbook_Open() ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Select End Sub 次のように操作してみてください。 １.エクセル画面に戻り、１行目に項目名を入力。 ２.データーを入力してみて下さい。自動的に計算されて表が完成していきます。
お礼
サンプルマクロの使用を試みました。 データは問題なく、作成できました。 始めの考えでは最終行に合計を入れてあるために、枠線に囲まれた行を1行ずつ増ていくことを考えていましたが、 作っていただいたマクロを利用していくことで便利になったことから比べれば、現行に必要な表では合計を出す作業は必要のたびでもかまわないことと思っています。 使用させていただくマクロは作成していただいたもので十分ですが、気づいた点として入力済のデータを選択範囲してDeleteするとマクロの「実行時エラー”１３”型が一致しません」のエラー表示のあること、一度入力して自動計算をした値は「区分」の有無を変更しただけでは自動計算はしないということです。 上記の2点の正負が私には判断つかないのですがご連絡をさせていただきます。 マクロを利用していきたいと足を踏み入れても、作っていただいたマクロを理解することもできない・・・何とか覚えたいが道は遠い・・・ 長い間、ご相談いただきまして本当に本当にありがとうございました！ また、宜しくお願いします。
- kazuhiko5681
- ベストアンサー率49% (79/159)
早速補足を頂きまして有難うございます。 数式からあなた様のやりたいことがうまく理解できません。 あなた様がこの表でやる操作手順を言葉で説明していただけませんでしょうか。 お手数をおかけいたしますが、よろしく御願いいたします。
補足
ありがとうございます。 操作手順の回答をと思って作成していましたが、うまく説明できずに時間がかかっていましたら先に回答を頂いてしまって・・・ #9で作成していただいた、サンプルを使ってみますので 結果、少々お時間くださいm(__)m
- 1
- 2
![その他([技術者向] コンピューター) イメージ](https://gazo.okwave.jp/okwave/spn/images/related_qa/c205_4_thumbnail_img_sm.png)
お礼
回答ありがとうございました。 修正していただいたマクロ、確認させていただきまた。 おかげさまでとても、使いやすい表を作成することができました。 少しでも簡単にデータ入力をと考えた小さなマクロから、大作業をしていただくこととなりお手数に感謝しています。 私はもちろん、社会復帰でがんばろうとする大お姉さま方も、ＰＣ恐怖症で仕事嫌いになることも減少すると喜んでます！ また、宜しくお願い致します。 ありがとうございました。