マクロで複数の行をまとめて切り取りする方法

前へ 次へ
このQ&Aのポイント
  • セルに「テスト」と「課題」があった場合、その行を切り取って別のシートに貼り付けるマクロのコードを教えてください。
  • 指定した列のセルに「テスト」と「課題」がある行をまとめて切り取り、別のシートに貼り付けるマクロの正しいコードを教えてください。
  • 指定した列のセルに「テスト」と「課題」がある行をまとめて切り取り、別のシートに貼り付けるマクロの実装方法を教えてください。
回答を見る
  • ベストアンサー

マクロで複数の行をまとめて切り取りする方法

Ｉの列のセルに「テスト」があったら、その行を切り取ってシート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 結果エラー 正常なコードを教えてくださいますか？ 宜しくお願いします。

  • nkmyr
  • お礼率67% (403/600)

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

  • ベストアンサー
  • FEX2053
  • ベストアンサー率37% (7987/21354)
回答No.1

そらあたりまえです。if文の書式が誤ってますもん。 If Cells(i, 9) = “テスト&課題” Then とかではなく If Cells(i, 9) = “テスト" or Cells(i, 9) = “課題” Then ですよね。 if文の直後は「論理式」が来ないとダメなので、Cells(i, 9) = “テスト&課題” だと、"テスト&課題”という文字列しか見つけに行きませんよ。

nkmyr
質問者

お礼

ありがとうございます。 動作できました。 orでしたか…

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

関連するQ&A

  • マクロ　行を切り取ってペーストでエラーになる

    J列に「0」と「#N/A」の行を切り取って集計対象外シートに貼り付けるといったコードです。 何故か途中でエラーになります。 どこが間違っておりますか？ 宜しくお願いします。 Dim LastRow As Long LastRow = Cells(Rows.Count, 10).End(xlUp).Row For i = 1 To LastRow If Cells(i, 10) = "0" Or Cells(i, 10) = "#N/A" Then Rows(i).Cut Sheets("集計対象外").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) End If Next i

  • 二つのマクロで一気に処理したい

    以下のようなことができるのかお伺い致します。よろしくお願い致します。 　やりたいこと 　　※　前提として、sheet1にすでにA列に通し番号で奇数の数字が入っている。 　　　1.sheet1からsheet2へコピペーストする。しかし、A列からO列のすべてにデータがあった場合のみコピー貼り付けさせたい。 　　　　(前提で示したように、A列に通し番号で奇数の数字が入っていて、A列のみ数字があり、以外が空欄の行があるため) 　　　2.下記のコピー貼り付けのコードと重複削除のコードを合体させて、一つの処理で動かしたい。 Sub コピー貼り付けつけ()　　'コピー貼り付けつけのコード Dim lastRow As Long 'Sheet1のA3から最終行までをコピー With Sheets("sheet1") .Range("A3:O" & .Cells(Rows.Count, "A").End(xlUp).Row).Copy End With 'Sheet2のA列の最終行の次の行に貼付け Sheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Application.CutCopyMode = False End Sub Sub 重複データを一括削除する() ' Macro1 Macro Dim i As Long, lastRow As Long, myRng As Range LastRow = Cells(Rows.Count, "A").End(xlUp).Row For i = 1 To lastRow - 1 If WorksheetFunction.CountIf(Range(Cells(i + 1, "O"), Cells(lastRow, "O")), Cells(i, "O")) > 0 Then If myRng Is Nothing Then Set myRng = Cells(i, "O") Else Set myRng = Union(myRng, Cells(i, "O")) End If End If Next i If Not myRng Is Nothing Then myRng.EntireRow.Delete End If End Sub

  • excelマクロの重複セルの削除について

    excelマクロ超初心者です。 Ｅ列に下記のようにデータが入っていたとします。 　　Ｅ列 １　いちご ２　りんご ３　みかん ４　いちご ５　りんご ６　れもん これを重複セルを削除して 　　Ｅ列 １　いちご ２　りんご ３　みかん ４　れもん としたいのですが、どうすればいいでしょうか？ 自分なりに調べて、下記のように記述したのですが、 Sub test() lastRow = wb.Sheets("Sheet1").Range("E" & Rows.Count).End(xlUp).Row 'E列最終行 For i = lastRow To 2 Step -1 If Cells(i, 5).Value = Cells(i - 1, 5).Value Then Cells(i, 5).EntireRow.Delete Shift:=xlUp End If Next i End Sub() Ｅ４列から下のデータしか重複セルが削除されません。 ここでいうlastRow To 2 Step -1はどういう意味なのでしょうか？ すみませんが宜しくお願いします。

  • 選択した行のみマクロを使いたい

    以前、こちらのサイトで表を展開するマクロを教えていただきました。 そのマクロをシート全体ではなく、任意の行や任意のセルにだけに使えるようにしたいです。 Sub 展開() Dim nLast As Long Dim vAdata, i, j Dim vData nLast = Cells(Rows.Count, 1).End(xlUp).Row '行を追加削除する時は下から上が基本 For i = nLast To 1 Step -1 vAdata = Cells(i, 1) 'A列が空白ではなく、B列が空白の場合、B列以降を上と同じにする If (vAdata <> "") And (Cells(i, 2) = "") And (i > 1) Then Rows(i) = Rows(Cells(i, 2).End(xlUp).Row).Value Cells(i, 1) = vAdata End If If vAdata = "" Then 'A列の値が空白なら削除 Rows(i).Delete Shift:=xlUp Else 'A列の最後に「,」が有る場合は取り除く If Right(vAdata, 1) = "," Then vAdata = Left(vAdata, Len(vAdata) - 1) End If vData = Split(vAdata, ",") 'A列の値がカンマで区切られていた場合 If UBound(vData) > 0 Then '対象行をコピーして区切られていた数-1だけ下に挿入 Rows(i).Copy Rows(i & ":" & i + UBound(vData) - 1).Insert Shift:=xlDown 'A列の値を区切られていた値に書き換える For j = 0 To UBound(vData) Cells(i + j, 1) = vData(j) Next j End If End If Next i End Sub というマクロを教えて頂きました。 これをどのようにすればいいでしょうか？ ご教授お願いします。

  • エクセル重複行統合マクロの意味

    Tom04さんの回答で 以下のとても素晴らしいマクロがあり、 使用させていただきたいのですが、 詳細がわかりません。 少々編集して自分の書類に反映させていただきたく、 マクロの内容を教えていただけませんか？ Sub test() 'この行から Dim i, j, k, L As Long Application.ScreenUpdating = False For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1 For j = 2 To Cells(1, Columns.Count).End(xlToLeft).Column + 1 For k = Cells(Rows.Count, j).End(xlUp).Row To 2 Step -1 If Cells(k, j) <> "" And WorksheetFunction.CountIf _ (Range(Cells(2, 1), Cells(k, 1)), Cells(k, 1)) > 1 Then L = WorksheetFunction.Match(Cells(k, 1), Columns(1), False) Cells(k, j).Cut Destination:=Cells(L, j) End If Next k Next j Next i For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1 If WorksheetFunction.CountA(Rows(i)) = 1 Then Rows(i).ClearContents End If Next i Application.ScreenUpdating = True End Sub 'この行まで

  • マクロ　入力する文字に色を付けたい

    Sub CountUp(ByVal mCol1 As String, mCol2 As String) Dim LastRow1 As Long Dim LastRow2 As Long Dim mRow As Long With Sheets("プレーヤー") LastRow1 = .Cells(Rows.Count, mCol1).End(xlUp).Row LastRow2 = .Cells(Rows.Count, mCol2).End(xlUp).Row If LastRow1 > LastRow2 Then mRow = LastRow1 Else mRow = LastRow2 End If If LastRow1 = 1 Then LastRow1 = 2 End If .Cells(mRow + 1, mCol1).Value = .Cells(LastRow1, mCol1) + 1 End With End Sub このコードに文字の色の指定をしたいです Selection.Font.ColorIndex = 3を入れたら赤色文字で入力できるかなと思ったのですがうまくいきませんでした（エラーにはならないのですが、色が付かなかったです）

  • マクロでファイルを読み込み、重複行を削除したい。

    35万件以上あるエクセルデータに対して、マクロを使って以下のような処理で重複業を削除したいと思っています。 Sub DeleteOldRow() Dim lastRow As Integer Dim i As Integer Dim j As Integer Dim strVal As String 'B列の最終行を求めます。 lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 2).End(xlUp).Row '1行目から最終行の前まで繰り返します。 For i = 1 To lastRow - 1 'チェックする値を、strValに代入します。 strVal = ActiveSheet.Cells(i, 2).Value '今見てる行から、下をチェックします。 For j = i + 1 To lastRow 'もし、値が同じであれば、 If strVal = ActiveSheet.Cells(j, 2).Value Then '元の行を削除します ActiveSheet.Rows(i).Delete '最終行が１行減ったのでlastRowの値を減らします。 lastRow = lastRow - 1 'チェックしている行を１行前に戻します。 j = j - 1 End If Next j Next i End Sub 上記処理を３５万件あるファイル上でマクロの実行すると、オーバーフローしてしまいました。マクロ側で対象ファイルを読み込むなどして、処理を軽くするやり方はありますでしょうか。上記処理にどのような処理を加えればスムーズに処理されるでしょうか。

  • 複数行コピー、貼り付け実行時エラー1004

    ユーザー側が任意の場所を選択コピー し(2行毎) また 任意の位置に貼り付ける動作ですが 1回目のコピー、貼り付けは正常動作しますが 再度 コピー(任意の場所),貼り付け時に1004実行エラーが発生します。 下記はコードです。 どうかご教授お願いいたします。 Dim StartRow As Long, LastRow As Long, SRC As Long Sub コピー() If ActiveCell.Row < 76 Then Exit Sub StartRow = ActiveCell.Row: SRC = Selection.Rows.Count If (ActiveCell.Row Mod 2) = 0 Then StartRow = ActiveCell.Row If (Selection.Rows.Count Mod 2) = 0 Then LastRow = StartRow + Selection.Rows.Count - 1 Else LastRow = StartRow + Selection.Rows.Count End If Else StartRow = ActiveCell.Row - 1 If (Selection.Rows.Count Mod 2) = 0 Then LastRow = StartRow + Selection.Rows.Count + 1 Else LastRow = StartRow + Selection.Rows.Count End If End If ActiveSheet.Range(ActiveSheet.Cells(StartRow, 1), ActiveSheet.Cells(LastRow, 19)).Copy End Sub Sub 貼付け() If ActiveCell.Row >= 76 Or Application.ClipboardFormats(1) <> -1 Then ActiveSheet.Unprotect If (ActiveCell.Row Mod 2) = 0 Then StartRow = ActiveCell.Row Else StartRow = ActiveCell.Row - 1 End If ActiveSheet.Paste Destination:=Cells(StartRow, 1): Application.CutCopyMode = False ActiveSheet.Protect End If End Sub

  • VBAのスピードについてご教示ください

    下記マクロは、シートAに氏名、郵便番号、住所・・・、と横に住所録を整理していて、列11番目に「対象」と入力されている行を順番にコピーして、シート「送付先一覧」に貼り付けるマクロをコピーしてエクセル2010で使用させていただいてるのですが、職場のエクセル2007では極端にスピードが遅くなります。 エクセル2007では、2010のように早くはならないのでしょうか？ 2007を使用してるパソコンが、少し古いからでしょうか？ 素人でよくわかりません。 遅くなる理由、また早くする方法があればご教示ください。 Sub 対象抽出() Dim i, LastRow As Long LastRow = Cells(Rows.count, 11).End(xlUp).Row For i = 1 To LastRow If Cells(i, 11) = "対象" Then Rows(i).Copy Sheets("送付先一覧").Cells(Rows.count, 1).End(xlUp).Offset(1, 0) End If Next i End Sub

  • １つのPCで同じマクロを複数動かす

    下記のマクロは、 A列にあるURLがSSL化（https）されているかを調べるものです。 このマクロで、いろんなURLを調べる作業があります。 その作業を早く完了させるために、下記のマクロを同時に動かそうと思っています。 しかし、エクセルを使えるPCが１つしかありません。 エクセルを２つ起動して、調べるURLを分けて、 ２つのエクセルでマクロを同時に動かす。 これをやろうと思いましたが、かなりPCが重くなるし、 エクセルが度々フリーズしたみたいになります。 どうにか、１つのPCで下記のマクロを複数動かして、 いろんなURLを調べる作業を、早くに完了する方法はありますでしょうか？ エクセル2016です。 よろしくお願いいたします。 Sub SSL() Dim objHttp As Object Dim nURL As String Dim strURL As String Dim i As Long, f As String, l As String Dim Lastrow As Long, getLine As Long Set objHttp = CreateObject("WinHttp.WinHttpRequest.5.1") On Error GoTo ErrHandler 'A1から getLine = Cells(Rows.Count, 2).End(xlUp).Row Lastrow = Cells(Rows.Count, 1).End(xlUp).Row If getLine = Lastrow Then MsgBox "既に終わっているか、データがないです。", vbExclamation: Exit Sub If getLine < Lastrow And Cells(1, 2).Value <> "" Then getLine = getLine + 1 Else getLine = 1 '最初の行が1行目からの場合 End If For i = getLine To Lastrow strURL = LCase(Trim(Cells(i, 1).Value)) 'A列の登録URL strURL = Replace(strURL, "https:", "http:") If strURL Like "http*" Then objHttp.Open "GET", strURL, False objHttp.send DoEvents 'ESC割り込み可能にする With objHttp If .Status = 200 Then nURL = .Option(1) 'WinHttpRequestOption_URL f = Mid(strURL, 1, InStr(strURL, "://")) l = Mid(nURL, 1, InStr(nURL, "://")) If nURL = "" Then Cells(i, 2).Value = "no URL" ElseIf nURL <> "" Then If LCase(f) = LCase(l) Then Cells(i, 2).Value = "non SSL" Else Cells(i, 2).Value = "https" End If End If Else Cells(i, 2).Value = "Err:" & .Status End If End With End If Endline: nURL = "" strURL = "" Next i MsgBox "Finished" Exit Sub ErrHandler: If Err() <> 0 Then Cells(i, 2).Value = Err.Number 'マイナスになるのは外部エラー GoTo Endline End If End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

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

質問する