- ベストアンサー
エクセルVBAで表から行の削除
- エクセルVBAを使用して、表から行を削除する方法について教えてください。
- 表は名前でソートされており、特定の列の比率をチェックして、100でない行を削除したいです。
- 同じ名前が複数行に分かれている場合、最大の比率の行を残し、他の行を削除する方法を知りたいです。
- みんなの回答 (2)
- 専門家の回答
関連するQ&A
- VBAの記録を追加したい
エクセル2002使用です。 VBAで次のコードを使っています。 Private Sub Worksheet_Change(ByVal Target As Range) Dim Rng As Range Set Target = Intersect(Range("C:C"), Target) If Target Is Nothing Then Exit Sub For Each Rng In Target If Rng.Value <> "" Then Rng.Offset(, -2).Value = Now Else ' (*) Rng.Offset(, -2).Value = "" ' (*) End If Next Rng End Sub (C列のセルに何か入力されると、A列の同じ行にその時刻が入る。) 同じシートで、F列に何か入力されるとE列の同じ行にその時刻が入るように書き直したいのですが、どうすればいいのでしょうか? すいませんが、よろしくお願いします。
- ベストアンサー
- Visual Basic
- エクセルVBAで表の塗りわけ
エクセル2003です。 添付画像のような表を、B列の時刻を基準に、何時台かで表を上から順に4色に色分けしようと思います。 一応、以下のコードで出来たのですが、Offset(-1).Value で見ている1行目のタイトル行が文字列なのでOn Error Resume Next でエラー回避しなくてはいけません。 他にもっと良い方法はないでしょうか? Sub test001() Dim cl As Variant Dim n As Long cl = Split("2,19,35,39", ",") For Each rng In Range("B2", Cells(Rows.Count, "B").End(xlUp)) On Error Resume Next If Hour(rng.Value) <> Hour(rng.Offset(-1).Value) Then n = n + 1 End If On Error GoTo 0 rng.EntireRow.Interior.ColorIndex = Val(cl(n Mod 4)) Next End Sub
- ベストアンサー
- その他MS Office製品
- エクセル2010 VBA 行削除
特定列が空白であれば行削除をしたいのですが、下記コードでうまく削除は出来るのですが、応答なしになったり、とても遅いのですが、もう少し早く処理出来る方法はありますか? E列が空白であれば行削除をしたいのですが・・ With Range("E13", Cells(Rows.Count, 5).End(xlUp)) .AutoFilter Field:=1, Criteria1:="" On Error Resume Next Set rng = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible) If Err.Number = 0 Then rng.EntireRow.Delete On Error GoTo 0 .AutoFilter End With
- 締切済み
- Excel(エクセル)
- エクセル 最終行からの連続コピー
* すぐに回答を! エクセルC20からI51までデータを1日1行ずつ入力します。 データが入力されている最終行から上に連続する10行(最終行含む)をコピーしたいのですが、最終行から10行上をどのように認識させたらいいのか、わかりません。Offsetなど試してみましたがダメでした。 よろしくお願いします。 Sub dataコピー() Dim i As Long Dim j As Integer Dim rng As Range '最後尾から10行前までを選択 With Worksheets("月").Range(Cells(20, 3), Cells(51, 10)) For i = Cells(Rows.Count, 1).End(xlUp).Row To -10? If rng Is Nothing Then Set rng = .Rows(i) End If j = j + 1 If j >= 10 Then Exit For Next i 'コピー If Not rng Is Nothing Then rng.Copy Range("M1") Beep Else MsgBox "該当行は存在しません。", 48 End If End With Set rng = Nothing End Sub コードはこちらを参考にしました http://questionbox.jp.msn.com/qa5440189.html
- 締切済み
- オフィス系ソフト
- Excelで条件つき行削除について教えてください
前回に下記のような質問をしました。 「下記のようなExcelの表があるとします。 A B C D E 1 会社A 会社B 会社C 会社D 2 仕事A 23 45 67 27 3 仕事B 45 24 65 33 4 小計 68 69 132 60 この状態のときはいいのですが、 A B C D E 1 会社A 会社B 会社C 会社D 2 仕事A 0 0 0 0 3 仕事B 0 0 0 0 4 小計 0 0 0 0 このときに小計という文字を認識し、その横にある数字を認識し、その条件がすべて「0」だった場合に処理を行いたいです。」 この回答で、 「Sub 小計全部ゼロ_行非表示() Dim Rng As Range For Each Rng In Range("A1", Range("A65536").End(xlUp)) If Trim(Rng.Value) = "小計" And _ Rng.Offset(, 1) = 0 And Rng.Offset(, 2) = 0 And _ Rng.Offset(, 3) = 0 And Rng.Offset(, 4) = 0 Then Rng.EntireRow.Hidden = True End If Next Rng End Sub」 このような回答がありました。 私は「小計」がC列にあり、「0」を検索したいのがF、G、H、Iにあります。 条件に合うように変更したのですがエラーが出てしまいます。 分かる方いましたら教えてください。」よろしくお願いします。
- 締切済み
- オフィス系ソフト
- エクセルVBAで最小値を求めたいのですが
下記はある表の最大値を求めるものですが 同様の条件で最小値を求めようと思い 「MAX」の箇所を「MIN」差し替えてできると思っていたのですが 最小値がのかわりに「0」が表示されてしまいます。 そのように修正すればよいでしょうか? private sub worksheet_change(byval Target as excel.range) if target.cells(1) = "" then exit sub if target.address = "$A$1" then Range("C10:C65536").ClearContents With Range(Cells(9 + Range("A1").Value, "C"), Cells(Range("A65536").End(xlUp).Row, "C")) .FormulaR1C1 = "=MAX(RC2:R[" & -Range("A1").Value + 1 & "]C2,FALSE)" .Value = .Value End With elseif target.address = "$E$1" then Range("G10:G65536").ClearContents With Range(Cells(9 + Range("E1").Value, "G"), Cells(Range("E65536").End(xlUp).Row, "G")) .FormulaR1C1 = "=MAX(RC6:R[" & -Range("A1").Value + 1 & "]C6,FALSE)" .Value = .Value End With end if end sub
- ベストアンサー
- オフィス系ソフト
- エクセルVBA
A列を基準にBC列が空白ならAの数値を入れて、A>BならB列を更新、A<CならC列を更新 A列が数値以外ならその行をスキップ、という処理をしたいのですが Option Explicit Dim A As Range, B As Range, C As Range Dim i As Long Sub test() For i = 1 To 10 Set A = Cells(i, 1) Set B = A.Offset(0, 1) Set C = A.Offset(0, 2) If IsNumeric(A) Then Else Exit Sub End If If B.Value = "" Then B.Value = A.Value If C.Value = "" Then C.Value = A.Value If A.Value > B.Value Then B.Value = A.Value If A.Value < C.Value Then C.Value = A.Value Next i End Sub とすると数値以外の行の時点で停止してしまいます。 その行を飛ばして次の行に進むにはどうしたらいいのでしょうか?
- ベストアンサー
- Visual Basic
- エクセル VBA の質問です。
A2~A20までのセルに文字を入力した段階で、それぞれB2~B20に入力日時を入れるVBAを以下のように組んでいます。 しかし、同様の条件を同一シートのE2~E20・F2~F20にも入力・自動表示できるようにしなければならなくなり、困っています。 どのように記述を変えればよいのか、教えていただけたらと思います。 宜しく御願いいたします。 Sub Worksheet_change(ByVal Target As Range) Dim Rng As Range Dim c As Range Set Rng = Range("A2:A20") If Intersect(Target,Rng) Is Nothing Then Exit Sub For Each c In Intersect(Target,Rng) If Not IsEmpty(c) Then c.Offset(, 1).Value = Now Else c.Offset(, 1).ClearContents End If Next Rng.Offset(, 1).EntireColumn.AutoFit End Sub 申し訳ありませんが、何卒、宜しく御願いいたします。
- ベストアンサー
- オフィス系ソフト
- エクセル 最終行からの連続コピー
エクセルで最終行から上に連続する10行(最終行含む)をコピーしたいです。 途中、空白行が含まれている場合でも、最終行を特定し、コピーできるようにするには、下記のコードにどう手を加えたらよいでしょうか? どなたかアドバイスをお願いします。 Sub Test() Dim i As Long Dim j As Integer Dim rng As Range With ActiveSheet 'フィルタ .Range("A1").CurrentRegion.AutoFilter Field:=1 '行選択 With .AutoFilter.Range For i = .Cells(.Cells.Count).Row To 2 Step -1 If .Rows(i).Hidden = False Then If rng Is Nothing Then Set rng = .Rows(i) Else Set rng = Union(rng, .Rows(i)) End If j = j + 1 End If If j >= 10 Then Exit For Next i 'コピー If Not rng Is Nothing Then rng.Copy Worksheets("Sheet2").Range("A1") Beep Else MsgBox "該当行は存在しません。", 48 End If End With End With Set rng = Nothing なお、コードはこちらを参考にさせていただきました。 http://okwave.jp/qa3552420.html?ans_count_asc=1
- 締切済み
- その他MS Office製品
- エクセルVBAについて
http://okwave.jp/qa/q7236213.html 上記質問の発展形なのですが 同様のことを E列に日付 F列に売上 G列に結果 でやりたいのですが この時A列~C列のマクロも残したままでしたいのですが 下記のように同様のプロシージャーを下段に書けばできると思ったのですが うまくいきません。 Private Sub worksheet_change(ByVal Target As Excel.Range) If Target.Address <> "$A$1" Then Exit Sub If Target = "" Then Exit Sub Range("C10:C65536").ClearContents With Range(Cells(9 + Range("A1").Value, "C"), Cells(Range("A65536").End(xlUp).Row, "C")) .FormulaR1C1 = "=MAX(RC2:R[" & -Range("A1").Value + 1 & "]C2,FALSE)" .Value = .Value End With End Sub Private Sub worksheet_change(ByVal Target As Excel.Range) If Target.Address <> "$E$1" Then Exit Sub If Target = "" Then Exit Sub Range("G10:G65536").ClearContents With Range(Cells(9 + Range("E1").Value, "G"), Cells(Range("E65536").End(xlUp).Row, "G")) .FormulaR1C1 = "=MAX(RC6:R[" & -Range("A1").Value + 1 & "]C6,FALSE)" .Value = .Value End With End Sub どなたかお知恵を拝借できませんでしょうか?
- ベストアンサー
- オフィス系ソフト
お礼
watabe007さん、さっそくのご回答ありがとうございます。 なあるほど~! 比率も降順で並べ替えしてしまえば下から順に合計100未満を片っ端から消していけばいいわけですね! 勉強になりました。 ありがとうございます。