一日おきに列を一つ横に移動させるVBA

前へ 次へ
このQ&Aのポイント
  • 一日おきに列を一つ横に移動させるVBAについての質問です。行を下に移動させて記録させる方法について教えてください。
  • VBAを使用して一日おきに列を一つ横に移動させる方法についての質問です。最新のデータが記入されるようにするにはどうすればいいですか？
  • 一日おきに行を下に移動させてデータを記録するためのVBAについての質問です。データが全て同じになってしまう問題について教えてください。
回答を見る
  • ベストアンサー

一日おきに列を一つ横に移動させるVBA

1/11に『一日おきに列を一つ横に移動させるVBA』 という事で質問させていただいたのですが また問題が出てきたので、教えてください。 結局一日おきに行を下に移動させて記録させる事にしました。 Dim a As Long a = CLng(Date) - 37633 Sheets("日常管理").Cells(a + 3, 3).FormulaR1C1 = "=奇数!R5C14" Sheets("日常管理").Cells(a + 3, 4).FormulaR1C1 = "=奇数!R6C14" Sheets("日常管理").Cells(a + 3, 5).FormulaR1C1 = "=奇数!R7C14" 毎日のデータを記録させて行きたいのですが全部が同じ（最新の値）になってしまいます。 どうやれば、その日その日のデータが記入されていくのでしょうか？

質問者が選んだベストアンサー

  • ベストアンサー
  • wildcard
  • ベストアンサー率54% (54/100)
回答No.1

奇数シートが日々の入力のためのシートと言う事なら、セルに計算式を設定するのではなく、値を代入する方法の方が良いと思います。つまり Sheets("日常管理").Cells(a+3,3).Value=Sheets("奇数").Cells(5,14).Value Sheets("日常管理").Cells(a+3,4).Value=Sheets("奇数").Cells(6,14).Value Sheets("日常管理").Cells(a+3,5).Value=Sheets("奇数").Cells(7,14).Value という感じで、どうでしょう？

momo999
質問者

お礼

この間も教えてくださった方ですね。 ありがとうございます。 （日常管理）に飛ばす値は（奇数シート）に毎日のデータを入力することによりでた計算結果の部分なのです。 毎日奇数シートにデータを打ち込んで上書き、上書きの繰り返しということをしたいのです。

momo999
質問者

補足

してみました 出来たみたいです！ ありがとうございました

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • 一日おきに列を一つ横に移動させるVBAどうすればいいのでしょうか

    困っています。助けてください 初心者過ぎて訳のわからない事言ってるかも知れませんが・・・ Sheets("奇数").Select Range("N5").Select Selection.Copy Sheets("Sheet1").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "=+奇数!R[2]C[11]" Range("C4").Select ActiveCell.FormulaR1C1 = "=+奇数!R[2]C[11]" Range("C5").Select やりたいことは 奇数シートのN5をシート１のC3に転記 奇数シートのN6をシート１のC4に転記 次の日には 奇数シートのN5をシート１のD3に転記 奇数シートのN6をシート１のD4に転記 次の日には 奇数シートのN5をシート１のE3に転記 奇数シートのN6をシート１のE4に転記 よろしくお願いします。 時間が無くて本を読んでいるのですが、なかなかわかりません

  • R5C14の意味を教えてください

    一日おきに列を一つ横に移動させるVBAどうすればいいのでしょうか と１１日に質問をしていたのですが、また行き詰ってしまいました。 ちょっと、急いでおりましてもう一度新しく質問させていただきます。 Sheets("Sheet1").Cells(3, a + 3).FormulaR1C1 = "= 奇数!R5C14" この奇数!R5C14が、なぜ奇数シートのN５になるんですか？

  • VBAについて質問です。

    VBAについて質問です。 まとまったデータがあるところから検索したい月及び各項目のデータを検索し、項目シート事に抽出するという作業を行なっています。そこで問題がでました。6月にはデータはあるが、5月にはデータはない。 そうすると以下のコードの場合デバックが入り、他の検索が出来ません。 どうしたらよいのでしょうか？ 分かる方がいらっしゃいましたらどうかお願い致します。 'シートの変更 Range("B30").Select Sheets("東京").Select '●Sheet2書込み行 Sheets("東京").Range("A5").CurrentRegion.Clear Sheets("東京").Range("A5:F5").Value = _ Array("依頼書No.", "受付日日", "担当者", "枚数", "工数", "備考") Row2 = 5 For R = 2 To Sheets("日報").Cells(Rows.Count, "A").End(xlUp).Row If Sheets("東京").Range("A2") = Sheets("日報").Cells(R, "A") And _ Sheets("東京").Range("B2") = Month(Sheets("日報").Cells(R, "C")) Then Row2 = Row2 + 1 Sheets("東京").Cells(Row2, "A") = Sheets("日報").Cells(R, "B") Sheets("東京").Cells(Row2, "B") = Sheets("日報").Cells(R, "D") Sheets("東京").Cells(Row2, "C") = Sheets("日報").Cells(R, "F") Sheets("東京").Cells(Row2, "D") = Sheets("日報").Cells(R, "I") Sheets("東京").Cells(Row2, "E") = Sheets("日報").Cells(R, "K") Sheets("東京").Cells(Row2, "F") = Sheets("日報").Cells(R, "L") End If Next R '●抽出結果を日付で並べ替え If Row2 = 5 Then MsgBox "該当データなし！" Else Sheets("東京").Range("A5:F" & Row2).Sort _ Key1:=Range("B6"), Order1:=xlAscending, _ Header:=xlYes, OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom, SortMethod:=xlPinYin End If Sheets("東京").Select Range("B5:B200").Select Selection.NumberFormatLocal = "yyyy/m/d" 　　　　Rows("5:5").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .ShrinkToFit = False .MergeCells = False End With このあとに式を入れて、罫線を入れてコピーして、というコードが入っています。 どうぞ宜しくお願い致します。

  • VBAでエラーになってしまう

    初心者です。 RangeクラスのSelectメゾットが失敗しました。となります。 このコードは、マクロの記録を行い、そのコードをコマンドボタンのコードにコピーしたものです。 初心者なので、マクロの記録からやりました。 どうか、わかる方がいらっしゃいましたら、教えてください。 Private Sub CommandButton4_Click() Sheets("印刷ページ").Select ActiveCell.FormulaR1C1 = "='鈴木　一郎'!R[2]C" Range("C6").Select　←ここが黄色くなり、エラーになります。 ActiveCell.FormulaR1C1 = "='鈴木　一郎'!R[2]C" Range("D6").Select ActiveCell.FormulaR1C1 = "='鈴木　一郎'!R[2]C" Range("E6").Select ActiveCell.FormulaR1C1 = "='鈴木　一郎'!R[2]C" Range("B8").Select ActiveCell.FormulaR1C1 = "='鈴木　一郎'!R[2]C" Range("C8").Select ActiveCell.FormulaR1C1 = "='鈴木　一郎'!R[2]C" Range("D8").Select ActiveCell.FormulaR1C1 = "='鈴木　一郎'!R[2]C" Range("E8").Select ActiveCell.FormulaR1C1 = "='鈴木　一郎'!R[2]C" Range("F8").Select ActiveCell.FormulaR1C1 = "='鈴木　一郎'!R[2]C" Range("B10").Select ActiveCell.FormulaR1C1 = "='鈴木　一郎'!R[2]C" Range("C10").Select ActiveCell.FormulaR1C1 = "='鈴木　一郎'!R[2]C" Range("D10").Select ActiveCell.FormulaR1C1 = "='鈴木　一郎'!R[2]C" Range("E10").Select ActiveCell.FormulaR1C1 = "='鈴木　一郎'!R[2]C" End Sub

  • エクセルＶＢＡについて教えてください。

    DSUMを使ってVBAで自動計算をさせたいのですがうまくいきません。 　・Sheetsデータにデータを置いていて、A1からU1610までデータが入ってます。 　・Sheets集計用は計算させるための（条件を入れる）シートで、A1からE列まで（選択する項目によって何行目になるかわかりません。） 　・mycountでE列のデータが入ってる行を出してます。 　・部屋タイプで1K～1LDKを選ぶとDSUMの式のタイプに1を入れたいのです。（1K～1LDKの場合はCells(1,3) 下記のように書いてみましたが上手くいきません。 どなたかご教授いただけると助かります。 mycount = "=COUNT(集計用!E2:E300)" Sheets("集計用").Cells(5, 7).Value = Range("g10") = " =DSUM(cells(データ!,1),1610,21),cells(データ!1,タイプ),cells(集計用!),cells(mycount,5))" '部屋タイプの選択 If Sheets("フォーム").Range("c30") = "1K～1LDK" then　 タイプ = 3 ElseIf Sheets("フォーム").Range("c30") = "2K～2LDK" Then タイプ = 6 ElseIf Sheets("フォーム").Range("c30") = "3K～3LDK" Then　 タイプ = 9 ElseIf Sheets("フォーム").Range("c30") = "4K～4LDK" Then タイプ = 12 Else Sheets("フォーム").Range("c30") = "その他" Then タイプ = 15 End If

  • ＶＢＡの転記について

    With Sheets("入力") '3行目～22行目まで For i = 5 To 24 SheetName = Sheets("入力").Cells(i, "C").Value On Error Resume Next Set Dummy = Sheets(SheetName) SheetName2 = .Cells(i, "C").Value U最終行 = Sheets(SheetName2).Range("C65536").End(xlUp).Row + 1 If U最終行 = 39 Then Sheets(SheetName2).Copy BEFORE:=ActiveSheet Sheets(SheetName).Delete End If If Err.Number = 0 Then A = Sheets(SheetName2).Range("C65536").End(xlUp).Row + 1 Sheets(SheetName2).Range("C" & A).Value = .Cells(i, "G").Value Sheets(SheetName2).Range("D" & A).Value = .Cells(i, "I").Value Sheets(SheetName2).Range("E" & A).Value = .Cells(i, "L").Value Sheets(SheetName2).Range("F" & A).Value = .Cells(i, "N").Value Sheets(SheetName2).Range("G" & A).Value = .Cells(i, "P").Value Sheets(SheetName2).Range("H" & A).Value = .Cells(i, "R").Value Sheets(SheetName2).Range("I" & A).Value = .Cells(i, "T").Value Sheets(SheetName2).Range("K" & A).Value = .Cells(i, "V").Value Sheets(SheetName2).Range("L" & A).Value = .Cells(i, "X").Value ElseIf .Cells(i, "C").Value <> "" Then G = Sheets("原紙").Range("C65536").End(xlUp).Row + 1 Sheets("原紙").Range("B1").Value = .Cells(i, "D").Value Sheets("原紙").Range("B4").Value = .Cells(2, "D").Value Sheets("原紙").Range("C" & G).Value = .Cells(i, "G").Value Sheets("原紙").Range("D" & G).Value = .Cells(i, "I").Value Sheets("原紙").Range("E" & G).Value = .Cells(i, "L").Value Sheets("原紙").Range("F" & G).Value = .Cells(i, "N").Value Sheets("原紙").Range("G" & G).Value = .Cells(i, "P").Value Sheets("原紙").Range("H" & G).Value = .Cells(i, "R").Value Sheets("原紙").Range("I" & G).Value = .Cells(i, "T").Value Sheets("原紙").Range("K" & G).Value = .Cells(i, "V").Value Sheets("原紙").Range("L" & G).Value = .Cells(i, "X").Value '原紙をコピーする Sheets("原紙").Copy BEFORE:=Sheets(1) 'シートの名前を市場コードにする Sheets(1).Name = SheetName End If Next i End With On Error GoTo 0 上記のＶＢＡを作成しましたが、 C行の値ごとの転記(Ｇ～Ｘの値)が出来ません。 どこが間違いか教えていただけないでしょうか。

  • エクセルVBAが書ける方へ

    お世話になります。 下記VBAはB19からB28までのデータをA11:12の横列に貼り付けさせる内容です。 Sub 特価() ' ' 特価 Macro ' ' Range("A11:A12").Select ActiveCell.FormulaR1C1 = "=R[8]C[1]" Range("B11:B12").Select ActiveCell.FormulaR1C1 = "=R[9]C" Range("C11:C12").Select ActiveCell.FormulaR1C1 = "=R[10]C[-1]" Range("F11:F12").Select ActiveCell.FormulaR1C1 = "=R[11]C[-4]" Range("H11:I12").Select ActiveCell.FormulaR1C1 = "=R[12]C[-6]" Range("T11:U12").Select ActiveCell.FormulaR1C1 = "=R[13]C[-18]" Range("X11:Y12").Select ActiveCell.FormulaR1C1 = "=R[14]C[-22]" Range("AD11:AE12").Select ActiveCell.FormulaR1C1 = "=R[15]C[-28]" Range("AN11:AO12").Select ActiveCell.FormulaR1C1 = "=R[16]C[-38]" Range("AW11").Select ActiveCell.FormulaR1C1 = "=R[17]C[-47]" Range("B23").Select End Sub これに下記内容を追加したいのですが教えて下さい。 ・B19からB28のデータは入力後消す。 ・貼り付けたら次に入力する時は下の行(A13:14)に貼り付ける。 ・同様にデータを消してA15:16に貼り付ける。以下、下の行に貼り付けていくようにする。 ・貼り付けたらカーソルはB19を選択した状態にする。 言葉足らずでしたら補足します。 何卒宜しくお願い致します。

  • Excel VBAについて

    以下のコードをFor Nextでまわすには どうしたらよいでしょうか？ Sub sample() Range("A2").Select ActiveCell.FormulaR1C1 = "=テスト!R[1]C" Range("A3").Select ActiveCell.FormulaR1C1 = "=テスト!R[3]C" Range("A4").Select ActiveCell.FormulaR1C1 = "=テスト!R[5]C" Range("A5").Select ActiveCell.FormulaR1C1 = "=テスト!R[7]C" Range("A6").Select ActiveCell.FormulaR1C1 = "=テスト!R[9]C" Range("A7").Select ActiveCell.FormulaR1C1 = "=テスト!R[11]C" End Sub

  • VBA データの統合機能

    Winは7、Excelは2013を使用しています。 以前、データの統合機能というのをこちらで教わり、 その構文を使用させて頂いているのですが、 下記の、方法を集計のところの、Rnage("A7")のところに、変数 ｒｎを使用したいのですが、 エラーコード438が出てしまいます。 あと、年間集計のところにデータを書きだすところで、画像の青枠の様に1列おきに書き出したいのですが、可能でしょうか？ 以上、2点ご教示頂けますようお願い致します。 Sub test_データの統合機能() Dim sArray() As String ReDim sArray(Sheets.Count - 2) As String Sheets("年間集計").Select Cells.ClearContents '-------------------------------------------- '科目年間集計 '-------------------------------------------- For i = 2 To Sheets.Count sShtName = Sheets(i).Name sShtAddress = Sheets(i).Range("M2").CurrentRegion.Address(, , xlR1C1) sArray(i - 2) = sShtName & "!" & sShtAddress Next i Sheets(1).Range("A1").Consolidate Sources:=sArray, _ Function:=xlSum, _ TopRow:=True, _ LeftColumn:=True, _ CreateLinks:=False '-------------------------------------------- '合計 '-------------------------------------------- Dim maxCol As Long Dim maxRow As Long Dim c As Integer Dim r As Integer maxCol = Range("A2").End(xlToRight).Column maxRow = Range("A2").End(xlDown).Row Cells(1, maxCol + 1) = "合計回数" Cells(1, maxCol + 2) = "合計時間" For r = 2 To maxRow For c = 2 To maxCol Step 2 Cells(r, maxCol + 1) = Cells(r, maxCol + 1) + Cells(r, c) Cells(r, maxCol + 2) = Cells(r, maxCol + 2) + Cells(r, c + 1) Next c Next r '-------------------------------------------- '方法を年間集計 '-------------------------------------------- Dim rn As Range Set rn = Cells(maxRow + 2, 1) For i = 2 To Sheets.Count sShtName = Sheets(i).Name sShtAddress = Sheets(i).Range("Q2").CurrentRegion.Address(, , xlR1C1) sArray(i - 2) = sShtName & "!" & sShtAddress Next i Sheets(1).Range("A7").Consolidate Sources:=sArray, _ Function:=xlSum, _ TopRow:=True, _ LeftColumn:=True, _ CreateLinks:=False '-------------------------------------------- 'このあとに合計を計算する '-------------------------------------------- '（略） End Sub

  • VBA で２つのプロシージャを一つにまとめたい

    いつもここにはお世話になっており、ありがとうございます。 さて、タイトルにもありました通り、下記２つのプロシージャでコマンドボタンを設定して、実行しておりますが、これを一つのプロシージャ（ボタン）にまとめたく、ご指導お願いいたします。 ○作ろうとしているＶＢＡの概要 １）EXCELのデータベースで、一枚目の「inputシート」に入力し、２枚目の「dataシート」でデータをどんどん格納していきます。 ２）データは、「顧客ＣＤボタン」で管理しており、これをキーとしています。 ３）「顧客ＣＤ」は[inputシート」ではＣ４セル、「ｄａｔａシート」ではＡ列にで管理しています。 ３）データは新規にデータを入力したときの登録ボタン（一つ目のプロシージャ）、既存のデータを編集して、上書きするときの、変更登録ボタン（二つ目のプロシージャ）があります。 ○相談したい内容 「登録ボタン」と「変更」ボタンを一つにまとめて、ひとつのボタンとして、新規にデータを登録するときも、変更したデータを登録するときも、同じボタンで行えるようにしたい。 '■１つ目のプロシージャー Private Sub CommandButton1_Click() '登録ボタン Dim row As Integer row = WorksheetFunction.CountA(Sheets("data").Columns(1)) Sheets("data").Cells(row, 2).Value = Range("C5").Value row = WorksheetFunction.CountA(Sheets("data").Columns(1)) Sheets("data").Cells(row, 3).Value = Range("C6").Value row = WorksheetFunction.CountA(Sheets("data").Columns(1)) Sheets("data").Cells(row, 4).Value = Range("C7").Value row = WorksheetFunction.CountA(Sheets("data").Columns(1)) Sheets("data").Cells(row, 5).Value = Range("F5").Value ActiveWorkbook.Save End Sub '■２つ目のプロシージャー Private Sub CommandButton3_Click() '変更ボタン Dim fRange As Range Dim fRow As Long If (Range("C4").Value = "") Then '顧客CDが入力されていない？ MsgBox "顧客コードを入力してください。", vbExclamation Exit Sub End If Set fRange = Sheets("data").Columns(1).Find(What:=Range("C4").Value, _ LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows) If (fRange Is Nothing) Then '見つからなかった？ MsgBox "入力された顧客コードが存在しません。", vbExclamation Exit Sub End If fRow = fRange.row '検索された顧客DCの行位置を求める Sheets("data").Cells(fRow, 2).Value = Range("C5").Value Sheets("data").Cells(fRow, 2).Value = Range("C5").Value Sheets("data").Cells(fRow, 2).Value = Range("C5").Value Sheets("data").Cells(fRow, 3).Value = Range("F5").Value

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する