- ベストアンサー
複数のセルでの方法
現在下記のようなマクロを組んであるのですが、これだと5列目が「0」のときの実行マクロです。 '5列目(工数)が「0」のとき該当する行の高さを「0」にする。 For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 If Cells(i, 5).Value = "0" Then Rows(i).RowHeight = 0 End If Next 私はこれではなくて、5列目と7列目の同じ行にあるセルに「0」がはいっていたら行の高さを「0」にしたいのです。 そこで私は If Cells(i, 5).Value = "0" Then これを If Cells(i, 5).Value = "0" And Cells(i, 7).Value = "0" Then にしたところエラーが発生しました。 良い方法があればお教えください。 よろしくお願いします。
- みんなの回答 （2）
- 専門家の回答
関連するQ&A
- Excelマクロについて
先日、OKWEBで教えてもらったマクロに手を加えて作ろうとしたのですが、エラーがでて動かなくなりました。 わかる方がいましたら教えてください。 よろしくおねがいします。 Sub 見積書() Application.ScreenUpdating = False '見積書(完成)シートを選択 Sheets("見積書(完成)").Select '行の高さを「15」にする。 Rows("6:67").Select Range("F6").Activate Selection.RowHeight = 15 'S列のS6:S56をコピーしてE6:E7に貼り付ける。 Range("S6:S56").Select Selection.Copy Range("E6:E7").Select ActiveSheet.Paste '5列目(工数)が「0」のとき該当する行の高さを「0」にする。 For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 If Cells(i, 5).Value = "0" And Cells(i, 7).Value = "0" Then Rows(i).RowHeight = 0 End If Next '「E8:E55」の範囲を四捨五入する。 For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 Range("E8:E55") = Application.Round(Range("E8:E55"), 0) '工数を四捨五入 Next 'C列の中に含まれる「小計」を検索しそこから6列目が「0」だったら行の高さを「0」にする。 Dim Rng As Range Const Retu = "C" For Each Rng In Range(Retu & "1", Range(Retu & "100").End(xlUp)) If Trim(Rng.Value) = "小 計" And _ Rng.Offset(, 6) = 0 Then Rng.EntireRow.Hidden = True End If Next Rng End Sub
- 締切済み
- オフィス系ソフト
- マクロ実行が遅い・・・
皆さんにおしえてもらいながら下記のようなマクロを組みました。 しかし、マクロを実行すると計算中が長いのです。 もしこのマクロに原因があれば教えてください。 よろしくお願いします。 －－－－－－－－－－－－－－－－－－－－－－－－－－ Sub 見積書作成() Sheets("見積書").Select '見積書シートを選択 For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 If Cells(i, 5).Value = "0" Then '工数が「0」のときは Rows(i).RowHeight = 0 '行高さ「0」 End If Next For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 Range("E8:E55") = Application.Round(Range("E8:E55"), 0) '工数を四捨五入 Next Dim Rng As Range Const Retu = "C" '<--- ここで「小計」の列を指定します。 For Each Rng In Range(Retu & "1", Range(Retu & "65536").End(xlUp)) If Trim(Rng.Value) = "小 計" And _ Rng.Offset(, 6) = 0 Then Rng.EntireRow.Hidden = True End If Next Rng End Sub
- ベストアンサー
- オフィス系ソフト
- 重複データーの集計、削除
どなたかご教授下さい。 下記のようにD列に重複する行があればI列に集計し、行削除するマクロを作成しました。 さらに、重複する基準となる列を複数(D列,F列,Ｇ列)に増やしたいのですが、上手く出来ません。 宜しくお願い致します。 Sub test() Dim i, j For i = 19 To Cells(Rows.Count, 2).End(xlUp).row - 1 For j = Cells(Rows.Count, 2).End(xlUp).row To i + 1 Step -1 If Cells(i, 4).value = "" Then Exit Sub If Cells(i, 4).value = Cells(j, 4).value Then Cells(i, 9).value = Cells(i, 9).value + Cells(j, 9).value Rows(j).Delete End If Next Next End Sub
- 締切済み
- Visual Basic
- マクロで複数の行をまとめて切り取りする方法
Ｉの列のセルに「テスト」があったら、その行を切り取ってシート2に貼り付ける といった流れのコードが下記です。 Sub 切り取り() Dim i, LastRow As Long LastRow = Cells(Rows.Count, 9).End(xlUp).Row For i = 1 To LastRow If Cells(i, 9) = “テスト” Then Rows(i).Cut Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) End If Next i End Sub ●Ｉの列のセルに「テスト」と「課題」があったら、その行を切り取ってシート2に貼り付ける といったものをしたいのです。 1. If Cells(i, 9) = “テスト” Then ↓ If Cells(i, 9) = “テスト,課題” Then 結果エラー 2. If Cells(i, 9) = “テスト” Then ↓ If Cells(i, 9) = “テスト&課題” Then 結果エラー 正常なコードを教えてくださいますか？ 宜しくお願いします。
- ベストアンサー
- Visual Basic
- エクセルのマクロについて
Sub ア_Click() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row If InStr(.Cells(i, "C"), "ア") = 0 Then If InStr(.Cells(i, "D"), "ア(半角)") = 0 and .Cells(i,"D")<>"" Then MsgBox i & "行目" Cells(i, 2).Offset(0, -1).Value = "★" End If End If Next i End With End Sub このエクセルマクロはC列に「ア」があって、D列に「ア(半角)」の文字がない場合はメッセージというマクロなのですが、このマクロをア～ンまで同じ作業をしたいのですが、ひとまとめにマクロを組む事はできるのでしょうか？できる場合どのようにすれば良いでしょうか? 下記のようにして見たのですができませんでした。 Sub ア_Click() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row If InStr(.Cells(i, "C"), "[ア-ン]") = 0 Then If InStr(.Cells(i, "D"), "[ア-ン](半角)") = 0 and .Cells(i,"D")<>"" Then MsgBox i & "行目" Cells(i, 2).Offset(0, -1).Value = "★" End If End If Next i End With End Sub
- 締切済み
- オフィス系ソフト
- 色のないセルの行削除
任意の色で塗りつぶされたセルがあって、塗りつぶされたセルが存在する行を削除するマクロ。 Sub 行削除() Dim r As Integer Dim c As Integer For c = ActiveSheet.UsedRange.Columns.Count To 1 Step -1 For r = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 If Cells(r, c).Interior.ColorIndex <> xlNone Then Rows(r).Delete End If Next Next End Sub この逆のことがしたいのですが、わかりません。 ちなみにこのプログラムはそのままＣ＆Ｐです。 内容もあまり理解できていません。(^_^;) 添付画像の逆に色のついた行だけ残したいです。 よろしくお願いします
- ベストアンサー
- Excel（エクセル）
- ExcelのVBAで高さの設定
どなたか教えて下さい。 報告書のフォーマットの作成をしています。 Ａ列からE列までは日付や名前等の内容が入力されています。 Ｆ列にはそれに関するコメントが入力されています。 コメントの文字数は、少なければ10字程度、多ければ320文字程度あります。 文字数に合わせて高さを変更させたいです。 その為、以下のような事を行いました。 (1)Ｇ列にＬＥＮ関数を用いて、文字数を表示 (2)Ｇ列の文字数によって高さを変更させるＶＢＡを作成 Sub Macro1() For i = 2 To 100 If Cells(i, 6) < 72 Then Rows(i).RowHeight = 80 ElseIf 73 < Cells(i, 6) < 108 Then Rows(i).RowHeight = 120 ElseIf 109 < Cells(i, 6) < 144 Then Rows(i).RowHeight = 160 ElseIf 145 < Cells(i, 6) < 180 Then Rows(i).RowHeight = 200 ElseIf 181 < Cells(i, 6) < 216 Then Rows(i).RowHeight = 240 ElseIf 217 < Cells(i, 6) < 252 Then Rows(i).RowHeight = 280 ElseIf 253 < Cells(i, 6) < 288 Then Rows(i).RowHeight = 320 ElseIf 289 < Cells(i, 6) < 324 Then Rows(i).RowHeight = 360 End If Next End Sub このＶＢＡに記述間違いがあるようで、 「文字数が72文字以内であれば、高さを80に変更。 文字数が73文字以上で108文字未満であれば、高さは120」 までは認識し・高さの設定を行ってくれますが、108文字以上あっても高さは120になってしまいます。 どなたか教えて下さい。 よろしくお願い致します。
- ベストアンサー
- オフィス系ソフト
- 別bookのセルを参照するにはどうしたらよいでしょうか
Next Forを使用したマクロで、そのNext For構文内で、別ブックのセルを参照したいのですが、どうしたらよいでしょうか。 下記のように作成してみたのですが、テストしてみると、同ブック同シートの該当セルを参照しているようで、機能しません。下記の書き方では間違っているのでしょうね・・・。 マクロ初心者で、とても初歩的な質問で申し訳ないのですが、教えていただきたく質問させていただきました。よろしくお願いします。 必要なブックは開いている状態です。 Cells(i,＿)はbook1・シート"AAA"のi行・＿列目を参照し、 Cells(n,_)はbook2・シート"BBB"のn行・＿列目を参照し、 Cells(s,_)はbook2・シート"BBB"のセルを参照してほしいのですが・・・。 (1) book1・シート"AAA"のi行18列目のセルとbook2・シート"BBB"のn行・1列目の値が同じであれば (2) （book2・シート"BBB"のn行・1列目）の1行下をｓ行目としてs行・4列目のセルとbook1・シート"AAA"のi行28列目のセルが同値であれば (3) s行4列目からｓ行9列目を”ClearContents”するという内容です。下記のマクロは全て記述しておりませんが、ここが間違っているのは確実だと思います。今後の勉強にも是非生かしていきたいと思っておりますので、どうぞよろしくお願いいたします。 Sub test01() Dim n As Long Dim i As Long Dim s As Long For i = 6 To Workbooks("book1.xlsx").Worksheets("AAA").Cells(Rows.Count, 16).End(xlUp).Row If Cells(i, 16) = "" Then Exit For Else For n = 4 To Workbooks("book2.xlsx").Worksheets("BBB").Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, 16) <> "" And Cells(i, 18).Value = Cells(n, 1).Value Then For s = n + 1 To Workbooks("book2.xlsx").Worksheets("BBB").Cells(Rows.Count, 4).End(xlUp).Row If Cells(s, 1) <> "" Then Exit For ElseIf ..............
- 締切済み
- Visual Basic
- セルの値が0はクリアするマクロ
エクセル2003です。 ある集計表において 4行目のH列からAM列まで 数値データがあります。 最終行は常に変化します この表内にてセルの値が0のセルは セル内を空白にしたいです。 以下のマクロを作成しましたが If Cells(処理行, 8).Value = 0 Then Cells(処理行, 8).ClearContents をあと(処理行, 13)から(処理行,31) まで記述しなければなりません。 構文的にも処理的にも不利？ と思うので、なにかいい方法を教えてください。 Sub 数字0クリア() '2012年2月3日節分 Dim 最終行 '最終列をG列で求めます 最終行 = Cells(Rows.Count, 7).End(xlUp).Row Application.ScreenUpdating = False For 処理行 = 4 To 最終行 If Cells(処理行, 8).Value = 0 Then Cells(処理行, 8).ClearContents End If If Cells(処理行, 9).Value = 0 Then Cells(処理行, 9).ClearContents End If If Cells(処理行, 10).Value = 0 Then Cells(処理行, 10).ClearContents End If If Cells(処理行, 11).Value = 0 Then Cells(処理行, 11).ClearContents End If If Cells(処理行, 12).Value = 0 Then Cells(処理行, 12).ClearContents End If If Cells(処理行, 13).Value = 0 Then Cells(処理行, 13).ClearContents End If Next 処理行 Application.ScreenUpdating = True MsgBox "終了しました" End Sub
- ベストアンサー
- オフィス系ソフト
- マクロ：データの抽出（複数条件）
エクセルで以下のようなマクロを作成しました。 シート1のG列がシート2のF4と合致する時、シート2のＣ列にシート1のＢ列を貼り付けるのですが、条件を増やし 「シート1Ｇ列がシート2のＦ４と一致」かつ「シート1Ｈ列がシート2のG5と一致」かつ「シート1I列がシート2のH5と一致」かつ・・・としたいのですが、If Thenをどのように記述したらよろしいでしょうか。（AND関数の機能です） 宜しくお願いいたします。 Sub data01() With Sheets("Sheet1") x = .UsedRange.Cells(.UsedRange.Count).Row For i = 5 To x If .Cells(i, "G").Value = Worksheets("Sheet2").Range("F4").Value Then n = n + 1 Sheets("Sheet2").Cells(n + 5, "C").Value = .Cells(i, "B").Value End If Next End With End Sub
- ベストアンサー
- オフィス系ソフト
