• 締切済み

データの抽出　と計算　表示

Ｅｘｃｅｌ2007でＶＢＡを使ってマクロを作っています。現在、ある表から特定の条件を満たした行の値の平均を別シートに表示させようとしているのですが、条件文のところでエラーが出てしまいます。原因がまだ初心者なもので？です。是非ご教授のほどお願いします ＊抽出はif文で、計算はいったん値をすべて合計して、その合計値を個数で割るという効率の悪いやり方をしています。変数はすべてintegerです /////////////////////////////////////////////////////////////// ・ ・ ・ i = 3 Worksheets("Sheet1").Activate Do While i < 150 ↓ここでエラーが出ます↓ If Worksheets("Sheet1").Range(Cells(i, 2)).Value = "02701?" Or "02730?" Then erea1 = Range(Cells(i, 4)).Value + erea1 cou1 = cou1 + 1 ・ ・ ・ j = 1 k = 63 Do While j < 13 ereaj = ereaj / couj Worksheets("Sheet2").Range(Cells(k, 5)).Value = ereaj j = j + 1 k = k + 2 Loop *表示は省略します* //////////////////////////////////////////////////////////////

回答 全件
何をしてるのかよくわかりませんが明らかに間違いと思われるとことを直すと…
If Worksheets("Sheet1").Range(Cells…

みんなの回答

  • merlionXX
  • ベストアンサー率48% (1930/4007)
回答No.2

何をしてるのかよくわかりませんが明らかに間違いと思われるとことを直すと If Worksheets("Sheet1").Cells(i, 2).Value = "02701?" Or Worksheets("Sheet1").Cells(i, 2).Value = "02730?" Then に修正 それから下のほうも Worksheets("Sheet2").Cells(k, 5).Value = ereaj　に修正

overerea
質問者

補足

今入れ替えてみたらエラーがスキップされました＾＾ありがとうございます。ほかのところも直してみます。

全文を見る
すると、全ての回答が全文表示されます。
noname#97729
noname#97729
回答No.1

If Worksheets("Sheet1").Range(Cells(i, 2)).Value = "02701?" Or Worksheets("Sheet1").Range(Cells(i, 2)).Value = "02730?" Then でどうですか

overerea
質問者

補足

試しに入れ替えてみましたが、やはり同じようなエラーが出てしまいます＞＜；

全文を見る
すると、全ての回答が全文表示されます。
  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • VBAで空欄にデータに表示

    エクセルVBAのIFを使って、シートaのA列に値があって、B列が空欄の場合のみ、空欄のセルにシートbの値を表示させたいです。 上手くできませんでしたので、教えてください。 Sub Do文2() Dim i As Integer i = 1 If Worksheets("a").Cells(i, 2) = "" Then Do While Worksheets("a").Cells(i, 1) <> "" Worksheets("a").Cells(i, 2) = Worksheets("b").Cells(1, 1) i = i + 1 Loop End If End Sub

  • VBAのコードについて質問です

    独学でエクセルVBAの初心者です。 定尺の鋼材から一定の長さのものが何本切り出せるかを調べるプログラムを作りたいです。 ネットで調べたところカッティングストック問題というものすごい難しいサイトに当たりましたが、 そのような難しいものではなく単純に同じ長さのものを切っていき、必要本数が取れたら次の長さを 切っていくというものを作りたいと思います（最終的に定尺何本必要か知りたい）。 まだまだ始めたばかりなのですが、do while文でorを使ったのですが反映されません。 なぜなのでしょうか？　iが３になった時点で引くのを止めたいのですが止まりません教えてください。 Sub Test() Worksheets("Sheet1").Cells(1, 2).Value = 5500 Worksheets("Sheet1").Cells(2, 2).Value = 1000 Worksheets("Sheet1").Cells(3, 2).Value = Range("B1").Value Dim i i = 0 Do While Range("B3").Value > Range("B2").Value Or Range("B4").Value = 3 i = i + 1　　　　　　　　　　　　　　　　　　　　　　　　　　　↑この部分 Range("B3").Value = Range("B3").Value - Range("B2").Value Loop Worksheets("Sheet1").Cells(3, 2).Value = Range("B3").Value Worksheets("Sheet1").Cells(4, 2).Value = i End Sub

  • 悩んでくれる方募集中！(コード掲載)

    いままで4月という名のシートの「A列」のランダムな位置に数字の[ 1 ]を数カ所とびとびで入力して列を選択した場合、選択した列に入っている行データーを合計請求書シートにあてはめて印刷しておりました。（下記コード使用） 悩みですが、プリント（プレビューでも可）したという証に[ 1 ]を入力していたセルに[ 1 ]を消して紫の色を付けたいのですが可能でしょうか。 又、1月から12月までシートと印刷用合計請求書シートからなるブックなのですが、月ごとに下記のコードの月表示のみ変更してコピーして使用しているため、12コードある状態です。 もっとスマートなコードおしえていただけないでしょうか。 よろしくお願いいたします。 Sub 合計請求書印刷4月() Dim Sheet1 As Worksheet Dim Sheet2 As Worksheet Set Sheet1 = ThisWorkbook.Worksheets("4月") Set Sheet2 = ThisWorkbook.Worksheets("合計請求書") Dim baseRow As Long ' 7行目から、2列目(顧客名)が空になるまでループ baseRow = 7 i = baseRow j = 1 Do While (Sheet1.Cells(i, 2).Value <> "") If (Sheet1.Cells(i, 1).Value = 1) Then Select Case j Mod 3 Case 1 Sheet2.Range("W8").Value = Sheet1.Cells(i, 2).Value Sheet2.Range("B15").Value = Sheet1.Cells(i, 8).Value Sheet2.Range("W15").Value = Sheet1.Cells(i, 10).Value Sheet2.Range("G15").Value = Sheet1.Cells(i, 9).Value Case 2 Sheet2.Range("W25").Value = Sheet1.Cells(i, 2).Value Sheet2.Range("B32").Value = Sheet1.Cells(i, 8).Value Sheet2.Range("W32").Value = Sheet1.Cells(i, 10).Value Sheet2.Range("G32").Value = Sheet1.Cells(i, 9).Value Case 0 Sheet2.Range("W42").Value = Sheet1.Cells(i, 2).Value Sheet2.Range("B49").Value = Sheet1.Cells(i, 8).Value Sheet2.Range("W49").Value = Sheet1.Cells(i, 10).Value Sheet2.Range("G49").Value = Sheet1.Cells(i, 9).Value ' 印刷プレビュー Sheet2.PrintPreview Case Else End Select j = j + 1 End If i = i + 1 Loop If j Mod 3 = 1 Then End Set Sheet2 = Nothing Set Sheet1 = Nothing Else Sheet2.Range("W42").Value = "" Sheet2.Range("B49").Value = "" Sheet2.Range("W49").Value = "" Sheet2.Range("G49").Value = "" If j Mod 3 = 2 Then Sheet2.Range("W25").Value = "" Sheet2.Range("B32").Value = "" Sheet2.Range("W32").Value = "" Sheet2.Range("G32").Value = "" End If Sheet2.PrintPreview End If Set Sheet2 = Nothing Set Sheet1 = Nothing End Sub

  • for～Next 構文の間に処理を追加したい。

    for～Next 構文の間に処理を追加したい。 ちょっと必要に迫られまして、他人の作ったEXCELマクロをいじらないといけなくなったのですが、小生初心者でどうもうまくいきません。 sheet1に条件を入れて、sheet2のセルに表示された内容をラベルに印刷するというプログラムなのですが、 PrintColum = Worksheets("sheet1").Range("L5").Value MaxGyou = Worksheets("sheet1").Range("L4").Value Maxrow = Worksheets("sheet1").Range("B" & Rows.Count).End(xlUp).Row Gyou = 1 + Worksheets("sheet1").Range("A3").Value Keta = 1 Worksheets("sheet2").Activate For k = 5 To Maxrow Hiduke = Worksheets("sheet1").Range("A" & k).Value ID = Worksheets("sheet1").Range("B" & k).Value Koumoku = Worksheets("sheet1").Range("C" & k).Value Kishaku_Min = Worksheets("sheet1").Range("D" & k).Value Kishaku_Max = Worksheets("sheet1").Range("E" & k).Value Maisu = Worksheets("sheet1").Range("F" & k).Value blank = Worksheets("sheet1").Range("G" & k).Value For i = Kishaku_Max To Kishaku_Min Step -1 For j = 1 To Maisu Keta = Keta + 1 Worksheets("sheet2").Range("A1").Cells(Gyou, Keta + 1).Value = " " & Hiduke & " " & ID & Chr(10) & " " & Koumoku + " 10^" + CStr(i) GyouHyouji = Worksheets("sheet2").Range("A1").Cells(Gyou, 1).Row Worksheets("sheet2").Range("A1").Cells(Gyou, 1).Value = (GyouHyouji - 1) Mod MaxGyou + 1 If Keta > PrintColum Then Keta = 1 Gyou = Gyou + 1 End If Next j Next i Next k Next i　の処理が終了したとき、blankの値が"1"なら、ひとつだけ内容の違うセルを差し込みたいと考えています。 わかる範囲でいろいろ試したのですが、まったくうまくいきません。 どなたかお知恵を拝借できないでしょうか？

  • 繰返し計算の高速化の方法をご指南願います

    いつも大変お世話になり有難うございます。 VBA初心者です。 早速ですがお尋ねします。 VBAで毎回条件変えて繰返すプログラムを作りましたが終了まで数時間かかり困ってます。 プログラムの全体の流れは、 約25000個のデータをあるパラメータで計算→計算結果とその時のパラメータをセル（i、1～9）に記入→パラメータを変更→約25000個のデータをあるパラメータで計算→計算結果とその時のパラメータをセル（i+1、1～9）に記入→・・・ というものです。繰り返し回数は1万回前後です。パラメータをもとに計算する式は簡単な加減則で、文字数の都合もあり割愛いたします。 試行錯誤の結果、 1.繰り返し計算の途中にある以下の多くのセル記入文の部分 2.1列目のセルに(IF(C77=100,"測定終了",IF(C77-J77>0,"下降","上昇")))、(IF(C78=100,"測定終了",IF(C78-J78>0,"下降","上昇")))・・・の式が約25000行に渡りは入っている事 3.2～4列目に時間、測定データ1、測定データ2が約25000個ずつセルに入っている事 がネックと分かりました（ファイル容量約3MB）。 Ｑ1、以下のセル記入方法を改善して高速化できる方法があればご指南いただけないでしょうか？ なおセルへの記入はWorksheets(1)にあるグラフに使用するのと、記入されたデータを後でソートして傾向を見るためのものです。また以下Ｒangeの値は一回の計算毎に変化するものです。 Range("J74") = Application.WorksheetFunction.Sum(Range("J76:J30000")) Range("K74") = Application.WorksheetFunction.Sum(Range("K76:K30000")) Range("L74") = Application.WorksheetFunction.Count(Range("J76:J30000")) Range("M74") = Application.WorksheetFunction.Count(Range("K76:K30000")) Worksheets(2).Cells(i, 1).Value = i - 1 Worksheets(2).Cells(i, 2).Value = Range("J74") Worksheets(2).Cells(i, 3).Value = Range("K74") Worksheets(2).Cells(i, 4).Value = Range("L74") Worksheets(2).Cells(i, 5).Value = Range("M74") Worksheets(2).Cells(i, 6).Value = Range("B32") Worksheets(2).Cells(i, 7).Value = Range("B33") Worksheets(2).Cells(i, 8).Value = Range("B31") Worksheets(2).Cells(i, 9).Value = Range("B34") Q2、(IF(C77=100,"測定終了",IF(C77-J77>0,"下降","上昇")))・・・、の式によりプログラムが遅くならない方法は考えられるでしょうか？（一回の計算毎に”下降””上昇”の数をcountしているため計算無効にすると困ります） Ｑ3、時間と測定データ１，２は繰返し計算のプログラムで使用する元データのため消してはまずいのですが、データの多さがプログラム速度に悪影響与えない方法はあるでしょうか？ 画面更新無効などは設定しています。 winXP、excel2002、cpu2.4GHz、RAM1GB、です。 字数の都合で前後式は省略してます。すみません。 ネットや書籍で調べ、当初より多少は速度が改善されたのですが、上記問題を残し力尽きてしまいました。 質問のうち一つでも結構ですので、ご指南よろしくお願いします。

  • コピペマクロを高速化したい（Excel）

    見よう見まねで以下のようなコードを書いてみたのですが、 これだと表示にやや時間がかかるので改善したいです。 ------ Sub コピペ() Dim i As Long i = Range("A1") Range("C12").Value = Worksheets("sheet2").Cells(i, 2).Value Range("D12").Value = Worksheets("sheet2").Cells(i, 3).Value Range("E12").Value = Worksheets("sheet2").Cells(i, 4).Value Range("F12").Value = Worksheets("sheet2").Cells(i, 5).Value Range("G12").Value = Worksheets("sheet2").Cells(i, 7).Value ------ こんな感じでコピペしたい値があと15個くらいあります。 コピー元とコピー先のセル配置には法則性があまりありません。 よろしくお願いします。

  • 表計算

    Sub TaskManager() Dim i As Integer Dim Maxval As Integer Dim Counter As Integer Dim AtoShoriFlg As String Set SH1 = Worksheets("Sheet1") Set SH2 = Worksheets("Sheet2") Maxval = WorksheetFunction.Max(Range("B:B")) Maxval = Maxval + 1 '初期値設定 i = 7 AtoShoriFlg = "ON" Counter = 1 Do While Cells(i, 4).Value <> "end" Select Case Cells(i, 4) Case Is = "新規エントリー" AtoShoriFlg = "OFF" i = i + 1 Case Is = "" Cells(i - 1, 4).Copy Cells(i, 4) Cells(i, 4).Font.Color = RGB(255, 255, 255) SH1.Range(SH1.Cells(i, 2), SH1.Cells(i, 6)).Borders(xlEdgeTop).LineStyle = xlLineStyleNone Case Is <> Cells(i - 1, 4) SH1.Range(SH1.Cells(i, 2), SH1.Cells(i, 6)).Borders(xlEdgeTop).LineStyle = xlContinuous SH1.Range(SH1.Cells(i, 2), SH1.Cells(i, 6)).Font.Color = RGB(0, 0, 0) If Cells(i, 2) = "" Then Cells(i, 2) = Maxval Maxval = Maxval + 1 End If Counter = 1 Case Else SH1.Range(SH1.Cells(i, 2), SH1.Cells(i, 6)).Borders(xlEdgeTop).LineStyle = xlLineStyleNone End Select If Cells(i, 2).Value = "" Then Cells(i, 2) = Cells(i - 1, 2).Value Cells(i, 2).Font.Color = RGB(255, 255, 255) End If If Cells(i, 3).Value = "" And Counter <> 1 Then Cells(i, 3) = Cells(i - 1, 3).Value Cells(i, 3).Font.Color = RGB(255, 255, 255) End If If AtoShoriFlg = "ON" Then Cells(i, 7) = Counter Counter = Counter + 1 End If i = i + 1 Loop SH1.Range(SH1.Cells(i, 2), SH1.Cells(i, 6)).Borders(xlEdgeTop).LineStyle = xlContinuous If AtoShoriFlg = "ON" Then SH2.Range("B2:F5").Copy Destination:=SH1.Cells(i, 2) End If End Sub

  • エクセルのマクロ（データの出力について）

    　　　　　　１２３４５６７８９１０・・・・　←　日付 田中　　　　１　１　　１　　　 中村　　　　　１　　１　　 鈴木　　　　１１１１１　　 　・ 　・ 　・ 上のようになっている表を下記のように変換したいのですが、マクロがうまく書けません。 Ａ　Ｂ　Ｃ　Ｄ　Ｅ　Ｆ　Ｇ　Ｈ　Ｉ　Ｊ　Ｋ　Ｌ　　Ｍ 　　１　　　２　　　３　　　４　　　５　　　６　　７　　←　日付 　　田中　　中村　　田中　　鈴木　　中村　　田中 　　鈴木　　鈴木　　鈴木　　　　　　鈴木 Sub test01() d = Worksheets("Sheet1").Range("A65536").End(xlUp).Row r = Worksheets("Sheet1").Range("IV2").End(xlToLeft).Column k = 4 '新規作成用の行ポインター For j = 2 To r For i = 3 To d If Worksheets("Sheet1").Cells(i, j) = 1 Then Worksheets("新規作成用").Cells(k, 2 * (j - 6)) = Worksheets("Sheet1").Cells(i, 2) k = k + 1 End If Next i Next j End Sub ここまで書いていきづまってしまいました。どなたかご指南ください。

  • エクセル　マクロ　抽出

    教えてください。 ○と記入されたセルを参照して、一つ上のセル・A列にある同じ行のセル・ 9行目にある同じ列のセルを抽出しようとしています。 下記の通り入力すると　行数＝値.Rowでエラーが出たしまいました。 試行錯誤頑張りましたが解決できそうにありませんのでお力を貸して頂けないでしょうか。 Sub 抽出() Dim i, 行数, 列数 As Long Dim 値 As Range i = 0 行数 = 値.Row 列数 = 値.Column For Each 値 In Sheets("sheet1").Range("C12:R171") If 値.Value = "○" Then i = i + 1 With Sheets("sheet2") .Cells(i, 3).Value = Sheets("sheet1").Cells(行数, 1).Value .Cells(i, 4).Value = Sheets("sheet1").Cells(9, 列数).Value .Cells(i, 5).Value = 値.Offset(-1, 0).Value End With End If Next End Sub

  • VBA エクセル　合計

    皆様、こんにちは。 それぞれの値が入っている会計シート（シートの形式は同じ）を一つの合計シートに合計しようとしていますが、うまくいきません。具体的に、数値の合計ができません。 例えば、ある項目に対して、シートAに100が入力され、シートBには230が入力されているとすれば、合計シートに100+230=330を入力したいです。なお、全ての会計シートは"Form"というエクセルシートにあり、その数をユーザが決めますので、検索しなければいけません。そして、合計シートは"Result"にあります。 以下のように書いてみましたが、間違っているようです。 Worksheets("Result").Activate Dim SR As Integer Dim SC As Integer 'SR is start row 'SC is start column SR = 6 SC = 2 Worksheets("Form").Activate Dim i As Integer i = 68 Do While 1 = 1 If Selection.Cells(i, 4).Value = "" Then Exit Do End If i = i + 49 Loop Sum = 0 Sum = Sum + Selection.Cells(i, 4) Worksheets("Result").Activate Cells(SR + 5, SC + 2) = Sum 詳しい方に教えていただければ非常に助かります。 どうぞよろしくお願いします。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

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

質問する