- 締切済み
エクセルＶＢＡのコピーがうまく出来ません
セルD3:D101に楽天SPのRSS数式の数値が表示されてきます。 3分おきにマクロを実行させ右側の列に順次データを追加していきたいのですが以下のマクロでは3分後にはセルE3:E101へ数式を含む全てがコピーされてしまい値だけをコピーできません。たぶん構文のCopy Cells(3, c + 1)を変更しなくてはいけないと思い試行錯誤したのですが分かりません。 どなたか教えてください。 Private Sub Macro1() Dim nextTime As Date Dim c As Date Dim d As Date Range("D3:D101").Select Selection.Copy c = Range("iv3").End(xlToLeft).Column d = Range("D65536").End(xlUp).Row Range(Cells(3, "D"), Cells(d, "D")).Copy Cells(3, c + 1) Columns("D:D").Select Application.CutCopyMode = False nextTime = Now() + TimeValue("00:03:00") Application.OnTime nextTime, "Macro1
- jeday8118
- お礼率74% (56/75)
- オフィス系ソフト
- 回答数1
- ありがとう数2
- みんなの回答 （1）
- 専門家の回答
みんなの回答
- merlionXX
- ベストアンサー率48% (1930/4007)
値だけをコピー貼り付けなら Range(Cells(3, "D"), Cells(d, "D")).Copy Cells(3, c + 1).PasteSpecial Paste:=xlValues としたらどうですか？
関連するQ&A
- エクセル ＶＢＡ 繰り返し コピー貼り付け
以下を繰り返し作業をOffsetを使用して行いたいのですがどうすればいいでしょうか？ Sheets("Sheet1").Select Range("A1:C1").Select のA1:C1以下へA1000:C1000ぐらいあります。 Sheets("Sheet2").Select Range("G1").Select は貼り付けたセル3つの数字の組み合わせで公式に使う計算期間がまちまちですので公式を張り付けたり出来ません。 D1の解を heets("Sheet1").Select Range("D1").Select に貼り付けてA1:C1以下1000までの結果を評価出来るようにしたいのですが！ ' Macro1 Macro Sheets("Sheet1").Select Range("A1:C1").Select Selection.Copy Sheets("Sheet2").Select Range("D1").Select ActiveSheet.Paste Range("G1").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet1").Select Range("D1").Select ActiveSheet.Paste Range("A2:C2").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("D1").Select ActiveSheet.Paste Range("G1").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet1").Select Range("D2").Select ActiveSheet.Paste Range("A3:C3").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("D1").Select ActiveSheet.Paste Range("G1").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet1").Select Range("D3").Select ActiveSheet.Paste End Sub よろしくおねがいします。
- ベストアンサー
- オフィス系ソフト
- エクセルVBA：マクロの中にマクロ？
度々よろしくお願いします。ボタンが複数あって、それぞれに記録されたマクロの一部分が共通している場合の処理について教えてください。 例えば、前回の質問でご回答いただいたモノを流用し、別の処理と複合させたマクロがあります。 この変数ixがボタン（それぞれのマクロ）ごとに異なる場合、Do While以下を別のマクロとして記録し、それぞれのマクロの中で Application.Run "TEST.xls!Macro1"などのようにできるのでしょうか？変数の扱いをどうして良いのかわかりません。 Sub test() ～別の処理 ix = 8 Do While Cells(ix, "D") <> "" Select Case Trim(Cells(ix, "D")) Case "背筋" Range("AZ8").Copy Destination:=Range(Cells(ix, "I"), Cells(ix, "AW")) Case "アーム" Range("BA8").Copy Destination:=Range(Cells(ix, "I"), Cells(ix, "AW")) Case "レッグ" Range("BB8").Copy Destination:=Range(Cells(ix, "I"), Cells(ix, "AW")) End Select Range(Cells(ix, "I"), Cells(ix, "AW")).Copy Cells(ix, "I").PasteSpecial Paste:=xlPasteValues ix = ix + 1 Loop Range("I8").Select End Sub
- ベストアンサー
- オフィス系ソフト
- Excelのontimeについて
a1に数式が入っています。 c3からd3,e3,f3…に一定時間ごとにa1の値を入力するマクロがあります。 Sub 入力() Sheets("Sheet1").Select Range("a3").End(xlToRight).Offset(0, 1).Select ActiveCell.Value = Cells(1, 1).Value End Sub Sub スタート() Dim MyTime As Date Dim Jikan As Date Dim i As Integer Jikan = TimeValue("13:59:00") For i = 0 To 5 MyTime = Jikan + TimeSerial(0, 0, 5) * i Application.OnTime MyTime, "入力" Next End Sub で、教えていただきたいのですが、"入力"を動かしている途中で 上記のマクロをとめるにはどうしたらよいのでしょう？ ご教授ください。
- ベストアンサー
- オフィス系ソフト
- ＶＢＡ超初心者です
皆さんのお知恵を拝借させてください。 Sub Macro1() ' ' Macro1 Macro ' マクロ記録日 : 2007/12/1 ユーザー名 : 101 ' Dim pearend As Integer Dim code As Integer Dim codeend As Integer Dim sheet_name As String Dim dayend As Date Sheets("商品名").Select Range("A4").Select Selection.End(xlDown).Select pearend = Selection.Row() For l = 4 To pearend Step 2 For r = 2 To 3 Cells(l, r).Select code = Cells(l, r).Value Select Case code Case 1000 To 1999 sheet_name = "1000" Case 2000 To 2999 sheet_name = "2000" Case 3000 To 3999 ssheet_name = "3000" Case 4000 To 4999 sheet_name = "4000" Case 5000 To 5999 sheet_name = "5000" End Select Sheets(sheet_name).Select Range("B4").Select Selection.End(xlToRight).Select codeend = Selection.Column() Range("A5").Select Selection.End(xlDown).Select dayend = Selection.Row() For i = 2 To codeend If code = Cells(4, i).Value Then Range(Cells(dayend, i), Cells(5, i)).Select Selection.Copy Sheets("商品名").Select Range("K3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If Next Next Next End Sub というマクロをつくってみたのですが、何順目かあたりから For r = 2 To 3 のｒがなぜか4になっています。正直知識がないのでさっぱりわかりません。どこに問題があるか詳しい方教えてください。
- ベストアンサー
- オフィス系ソフト
- VBAのSUBPRODUCT関数の引数について
ＶＢＡに詳しい方へ 部品単価積み上げなどで 部品単価×分子員数／分母員数の合計を計算するときにSUBPRODUCT関数を使いますがマクロ記録すると Range("D3").Select ActiveCell.FormulaR1C1 = "=SUMPRODUCT(R5C2:R9C2,1/R5C3:R9C3,R5C4:R9C4)" となります。 2列に員数分子 3列に員数分母、4列に部品単価が 5行から下に部品ごとに記入されています。 D3セルに 関数として入力されます。 これでは 部品の追加に対処できないので セルを変数にして表現したいのです。 これと同じことを ＶＢＡで行数可変に対応すると 分母員数の逆数を受け付けず 実行時エラー13：型が一致しない と表示されます。 Option Explicit Dim 分子群 As Range Dim 分母群 As Range Dim 単価群 As Range Sub Macro1() ' Range("D3").Select ActiveCell.FormulaR1C1 = "=SUMPRODUCT(R5C2:R9C2,1/R5C3:R9C3,R5C4:R9C4)" '---(1) 計算可能だが動的に対処不可能 End Sub Sub Macro2() Range("D3").Select Set 分子群 = Range(Cells(5, 2), Cells(Cells(5, 2).End(xlDown).Row, 2)) Set 分母群 = Range(Cells(5, 3), Cells(Cells(5, 3).End(xlDown).Row, 3)) Set 単価群 = Range(Cells(5, 4), Cells(Cells(5, 4).End(xlDown).Row, 4)) ActiveCell = Application.SumProduct(分子群, 分母群, 単価群) '---(2) エラー発生なし ActiveCell = Application.SumProduct(分子群, 1 / 分母群, 単価群) '---(3) エラー発生 (1)と同じ表現（分母）にできない。 End Sub これ以上のセル列は使わず、簡潔にD3セルへ入力するにはどうすればよろしいでしょうか？ 結果数値だけでなく、関数が入力されるのが希望です。 基本的知識が乏しく、恐縮ですが よろしくご回答をお待ちしております。------以上
- ベストアンサー
- その他（プログラミング・開発）
- エクセルVBAについて
前回質問させていただきました件の追加機能になります。以前質問させていただきましたマクロが下記のものです。 Sub TESTa() Dim A As Long Dim B As Long Dim C As Long Dim D As Long Dim E As Long Dim F As Long '表の行数を調べる A = Worksheets("sheet1").Range("C65536").End(xlUp).Row - 1 For C = 1 To A For B = 4 To 7 'Sheet1のデータをSheet2に複写する Worksheets("Sheet2").Cells(B - 3 + D, 15) = Worksheets("Sheet1").Cells(C + 1, 1) Worksheets("Sheet2").Cells(B - 3 + D, 6) = Worksheets("Sheet1").Cells(C + 1, B) Worksheets("Sheet2").Cells(B - 3 + D, 14) = Worksheets("Sheet1").Cells(C + 1, 3) Worksheets("Sheet2").Cells(B - 3 + D, 10) = Worksheets("Sheet1").Cells(1, B) Worksheets("Sheet2").Cells(B - 3 + D, 13) = Worksheets("Sheet1").Cells(C + 1, 2) Next D = C * 4 Next 'Sheet2の表の行数を調べる Sheets("Sheet2").Select E = Worksheets("sheet2").Range("F65536").End(xlUp).Row '0欄の確認 For F = E To 1 Step -1 If Worksheets("Sheet2").Cells(F, 6) = 0 Then '0の場合は行を削除する Cells(F, 1).EntireRow.Delete End If Next End Sub カウントするとデータ個数がSheet1で約１２０件になりSheet2においては、４倍になりますので約４８０件になります。 そこで Sheet1において１２件ごとに、Sheet2,3,4...としたいのです。 Sh1 NO.1～12がSheet2 Sh1 NO.13～24がSheet3 ... 10枚のシートにしたいのですが、このマクロにどのような命令を加えればよろしいでしょうか？ お手数ですがよろしくお願いいたします。
- 締切済み
- オフィス系ソフト
- ＥＸＣＥＬのＶＢＡについて
マクロのボタンで内容を削除する様に設定した所、 Dim re As Integer Sheets("投入シート").Select re = MsgBox("入力データをクリアします。" & vbCrLf & vbCrLf & "よろしいですか？", vbOKCancel, "クリア確認") If re <> vbCancel Then Sheets("投入シート").Select ActiveSheet.Unprotect Range("a1:c30").Select Selection.Copy Application.CutCopyMode = False Selection.Copy Sheets("work").Select Range("A1").Select ActiveSheet.Paste Sheets("投入シート").Select ActiveSheet.Unprotect Range("c4:c30").Select Selection.ClearContents Range("f31").Select Selection.Copy Range("c9").Select ActiveSheet.Paste Range("f33").Select Selection.Copy Range("c11").Select ActiveSheet.Paste Range("f32").Select Application.CutCopyMode = False Selection.Copy Range("c14").Select ActiveSheet.Paste Range("c4").Select Application.CutCopyMode = False 'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True End If Sheets("投入シート").Select Range("c4").Select End Sub この様に入力したのですがセルのＣ１１の計算式だけセル番号が消えてしまいます。 どうしてでしょうか？ご指導をお願いします。
- ベストアンサー
- その他MS Office製品
- マクロ 別シートへコピー
いつも回答して頂きありがとうございます。 Worksheets("一覧").Paste Range("C3")と記述したら、エラーもかからずうまく貼り付け出来るが、 Worksheets("一覧").Paste Range(Cells(d,3))と記述したらエラーが発生してしまします。どうしたら上手くいくでしょうか？ 下記に作成中のマクロを記載しておきます。 御指導の方よろしくお願いいたします。 Sub シートを繰り返し選択する(2)() Dim d As Integer Dim cVx As Integer d = 3 cVx = Range("IV7").End(xlToLeft).Column Worksheets(Worksheets("一覧").Cells(d, 2).Value).Range("C7:X7").Copy Worksheets("一覧").Paste Range(Cells(d, 3)) End Sub
- ベストアンサー
- オフィス系ソフト
- VBA マクロ処理時間の短縮について
下記のコードを作りましたが、マクロを実行すると砂時計マークが表示されて、処理が終了するまでに３０秒くらいかかります。 コードを変更して、マクロ処理時間を短縮する事はできないでしょうか？ Sub A列のコピー() Dim rw2 As Long Dim rw1 As Long Dim newdate As Date With Worksheets("sheet1") rw2 = .cells(.Rows.Count, "c").End(xlUp).Row newdate = .Range("c" & rw2).value For rw1 = rw2 - 1 To 1 Step -1 If .Range("c" & rw1).value <> newdate Then Exit For Next rw1 .Range(.cells(rw1 + 1, 1), .cells(rw2, 1)).Copy Worksheets("sheet2").Range("v6").PasteSpecial xlValue If rw1 + 26 <= rw2 Then .Range(.cells(rw1 + 26, 1), .cells(rw2, 1)).Copy Worksheets("sheet2").Range("v40").PasteSpecial xlValue Application.CutCopyMode = False End If Application.CutCopyMode = False End With End Sub 各セルは、６０００行くらいまで表示されています。 よろしくお願いします。
- ベストアンサー
- Visual Basic
- エクセルVBAについて
エクセルVBA初心者です。 左の表からある一定以上の売上を得た人を抽出し、右の表に表示したいのですが以下のプログラムだと上手くいきません。 どこがダメなのでしょうか？ Private Sub cmdUriken_Click() Dim k As Integer Dim l As Integer Dim m As Integer k = 2 l = 2 m = 2 Do Until Cells(m, 32) = "" Range(Cells(m, 19), Cells(m, 34)).Select Selection.ClearContents m = m + 1 Loop Do Until Cells(k, 14) = "" If Cells(k, 14) >= txtUriken.Text Then Range(Cells(k, 1), Cells(k, 16)).Select Selection.Copy Range(Cells(l, 19), Cells(l, 34)).Select ActiveSheet.Paste l = l + 1 Application.CutCopyMode = False End If k = k + 1 Loop End Sub ちなみに If Cells(k, 14) = txtUriken.Text Then とするとちゃんと同等の売上が表示されるので >= の使い方が間違っていると思うのですが よろしくお願いします。
- ベストアンサー
- Visual Basic
お礼
ありがとうございました。 検証した結果うまくいきました。 感謝いたします。