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

このQ&Aのポイント
  • 以前、こちらのサイトで表を展開するマクロを教えていただきました。そのマクロをシート全体ではなく、任意の行や任意のセルにだけに使えるようにしたいです。
  • 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 というマクロを教えて頂きました。これをどのようにすればいいでしょうか?ご教授お願いします。
  • マクロ「展開()」を使用して表を展開したいが、シート全体ではなく任意の行や任意のセルにだけ適用したいです。マクロのコードは提供されましたが、詳細な使用方法について教えてください。
回答を見る
  • ベストアンサー

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

以前、こちらのサイトで表を展開するマクロを教えていただきました。 そのマクロをシート全体ではなく、任意の行や任意のセルにだけに使えるようにしたいです。 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 というマクロを教えて頂きました。 これをどのようにすればいいでしょうか? ご教授お願いします。

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

  • ベストアンサー
  • keithin
  • ベストアンサー率66% (5278/7940)
回答No.1

「任意」とは,具体的にどういう具合にエクセルに指示したい(マクロがアナタのしたいことを理解できるやり方で)のですか? 例: 任意のセル範囲をヒトカタマリ選んで実行する。 変更前: For i = nLast To 1 Step -1 変更後: for i = selection.areas(1).row + selection.areas(1).rows.count -1 to selection.areas(1).row step -1

aaaabesi
質問者

お礼

回答ありがとうございます。 私の言った任意とは、おっしゃられた 「任意のセル範囲をヒトカタマリ選んで実行する。」 または、 「行番号をクリック、ドラッグして選択実行する。」 ということでした。 説明足らずで申し訳ないです。 ありがとうございました。

関連する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

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

    Iの列のセルに「テスト」があったら、その行を切り取ってシート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 ●Iの列のセルに「テスト」と「課題」があったら、その行を切り取ってシート2に貼り付ける といったものをしたいのです。 1. If Cells(i, 9) = “テスト” Then ↓ If Cells(i, 9) = “テスト,課題” Then 結果エラー 2. If Cells(i, 9) = “テスト” Then ↓ If Cells(i, 9) = “テスト&課題” Then 結果エラー 正常なコードを教えてくださいますか? 宜しくお願いします。

  • エクセルで表を展開するマクロを作りたい

    こんにちは。 エクセルで表を展開したいのですがマクロが作れません。 どなたか詳しい方教えて下さい。     A   B   C  D 1  1,2,3  abc  def  ghi を    A   B   C  D 1  1 abc  def  ghi 2   2  abc  def  ghi 3  3  abc  def  ghi というように展開したいです。 10列目くらいまで対応したマクロが作りたいです。 Sub test() 'この行から Dim i, j, k As Long Dim myArray As Variant For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1 If Not Cells(i, 1) Like "*" & "," & "*" Then i = i - 1 myArray = Split(Cells(i, 1), ",") k = UBound(myArray) Rows(i + 1 & ":" & i + k).Insert For j = 0 To k Cells(i + j, 1) = myArray(j) Next j Next i For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, 2) = "" Then Cells(i, 2) = Cells(i - 1, 2) End If Next i Columns("A:B").AutoFit End Sub 'この行まで これにどう付け足せばいいでしょうか? どうかご教授お願い致します。

  • 上のセルのコピーのマクロについて

    下記コードで、B列(数値)の空白のセルにその上の値をコピーしているんですが、C列(日付)で行ったところ、できませんでした。 Integerが違うと思って変えたんですが、ほかにも関連して変えるところがありますか?? 宜しくお願いいたします。 Sub 上のセルコピー() Dim i As Integer For i = 1 To Range("B" & Rows.Count).End(xlUp).Row If Cells(i, 2).Value = "" Then Cells(i, 2).Value = Cells(i - 1, 2).Value 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 'この行まで

  • Excel 2007 マクロ 別シートの情報を反映する方法

    Excel 2007 マクロ 別シートの情報を反映する方法 Sheet1とSheet2があります。 Sheet1のD列とSheet2のM列で同じ値があれば、 Sheet1のE列の値をSheet2のN列に反映するマクロを 作成しました。 下記が正しいと思っていたのですが、エラーメッセージは出ずに 値が反映されません。 マクロに問題点があればご指摘ください。 よろしくお願いいたします。 Sub Rist() Dim i, j As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") For i = 2 To ws1.Cells(Rows.Count, "D").End(xlUp).Row For j = 2 To ws2.Cells(Rows.Count, "M").End(xlUp).Row If ws2.Cells(j, "M") = ws1.Cells(i, "D") Then ws2.Cells(j, "N") = ws1.Cells(i, "E") End If Next j Next i End Sub

  • VBA 請求データ一覧からの複数の処理

    先週 kkkkkmさんに質問をさせて頂きまして、 いろいろご指導を頂いたものです。 続編の様な形になってしまいますが、 抽出するデータの環境設定を変更致しました。 ご質問させて頂く内容は前回とほとんど変更がないのですが、 あらためて下記に記載させて頂きます。 <Worksheet1のデータ> J列~AM列までが課税金額 「J,K,L」「M,N,O」・・・「AK,AL,AM」と3列1組(コード・費目・金額) 1組の行もあれば、複数組の行もあり。 AN列~BB列までが非課税金額 課税金額と同じく3列1組 1組の行もあれば、複数組の行もあり。 「BC」=消費税、「BD」=合計金額 ※AN列の前に不規則な空白セルあり   BC列の前に不規則な空白セルあり 文章で上手く説明出来ているか自信がありませんので、 エクスポートした元データ Worksheet1と、 vbaを用いて作成した Worksheet3 をご参考に添付致します。 Worksheet1の2行目がWorksheet3の2行目に対応しています。 3行目、4行目も同様です。 不規則な空白が原因でしょうか・・・。 M列、O列は問題ないのですが、 金額が合わなかったり、N列に金額を引いてこないのです。 実行しているコードは下記になります。 Dim i As Long, j As Long, k As Long Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet Dim mTotal(4) As Long Dim LastRow As Long Dim List(4) As Variant Set Ws1 = Sheets("Sheet1") Set Ws2 = Sheets("Sheet2") Set Ws3 = Sheets("請求書ひな形") List(1) = Ws2.Range(Ws2.Cells(1, "A"), Ws2.Cells(Rows.Count, "A").End(xlUp)).Value List(2) = Ws2.Range(Ws2.Cells(1, "B"), Ws2.Cells(Rows.Count, "B").End(xlUp)).Value List(3) = Ws2.Range(Ws2.Cells(1, "C"), Ws2.Cells(Rows.Count, "C").End(xlUp)).Value List(4) = Ws2.Range(Ws2.Cells(1, "D"), Ws2.Cells(Rows.Count, "D").End(xlUp)).Value LastRow = UBound(List(1)) For i = 2 To 4 If LastRow < UBound(List(i)) Then LastRow = UBound(List(i)) End If Next For i = 2 To Ws1.Cells(Rows.Count, "J").End(xlUp).Row mTotal(1) = 0 mTotal(2) = 0 mTotal(3) = 0 mTotal(4) = 0 For j = Columns("J").Column To Columns("BB").Column Step 3 For k = 2 To LastRow If UBound(List(1)) >= k Then If Ws1.Cells(i, j).Value = List(1)(k, 1) Then mTotal(1) = mTotal(1) + Ws1.Cells(i, j).Offset(0, 2).Value Exit For End If End If If UBound(List(2)) >= k Then If Ws1.Cells(i, j).Value = List(2)(k, 1) Then mTotal(2) = mTotal(2) + Ws1.Cells(i, j).Offset(0, 2).Value Exit For End If End If If UBound(List(3)) >= k Then If Ws1.Cells(i, j).Value = List(3)(k, 1) Then mTotal(3) = mTotal(3) + Ws1.Cells(i, j).Offset(0, 2).Value Exit For End If End If If UBound(List(4)) >= k Then If Ws1.Cells(i, j).Value = List(4)(k, 1) Then mTotal(4) = mTotal(4) + Ws1.Cells(i, j).Offset(0, 2).Value Exit For End If End If Next Next Ws3.Cells(i, "J").Value = mTotal(1) Ws3.Cells(i, "K").Value = mTotal(2) Ws3.Cells(i, "L").Value = mTotal(3) Ws3.Cells(i, "N").Value = mTotal(4) Ws3.Cells(i, "M").Value = Ws1.Cells(i, "BC").Value Ws3.Cells(i, "O").Value = Ws1.Cells(i, "BD").Value Next Set Ws1 = Nothing Set Ws2 = Nothing Set Ws3 = Nothing End Sub 本当に何度も申し訳ございません。 お時間がある時に見て頂けると有り難いです。 どうぞ宜しくお願い致します。

  • 重複行を完全削除するエクセルのマクロ

    Sub sakujyo() Dim i, ii As Long For i = 1 To Range("a65336").End(xlUp).Row For ii = Range("a65336").End(xlUp).Row To i + 1 Step -1 If Cells(i, 4).Value = Cells(ii, 4).Value _ And Cells(i, 13).Value = Cells(ii, 13).Value Then Delete Shift:=xlUp End If Next ii Next i End Sub マクロに関しては、素人でございます。 こちらのマクロを作ってみたのですがうまくいきません。 4列目と13列目の列が重複したときのみ重複した行をすべて削除させたいと思っております。どうぞお教えください。

  • 重複行を完全削除するエクセルのマクロ

    Sub sakujyo() Dim i, ii As Long For i = 1 To Range("a65336").End(xlUp).Row For ii = Range("a65336").End(xlUp).Row To i + 1 Step -1 If Cells(i, 2).Value = Cells(ii, 2).Value _ And Cells(i, 4).Value = Cells(ii, 4).Value _ And Cells(i, 5).Value = Cells(ii, 5).Value Then Dim iii As Byte iii = 1 Rows(ii).Delete Shift:=xlUp End If Next ii If iii = 1 Then Rows(i).Delete Shift:=xlUp iii = 0 Next i End Sub データーが下の表のように入っております。     A    B    C    E    F 1  1/26  a1234  fdsa  5000  C1 2  1/27  a4567  sdfa  4000  T2 3  1/28  a1234  dfsa  5000  C1 4  1/30  b4567  asdf  6600  A2 5  2/10  b4567  fsda  6600  A2 6  2/10  a1234  afds  5000  C1 B列、E列、F列が完全一致(重複1行目と3行目と6行目・4行目と5行目)で削除し結果的に2行目だけ残る方法がしたいのですが、このマクロですと少ないデータですとうまく動くのですが、『大量のデータを一気に削除出来ない』、『同じ重複が3つ以上のデータが多数ある場合データが削除されずに残ってしまう』エラーが出てしまいます。どうかお教えください。

  • 重複データーの集計、削除

    どなたかご教授下さい。 下記のようにD列に重複する行があればI列に集計し、行削除するマクロを作成しました。 さらに、重複する基準となる列を複数(D列,F列,G列)に増やしたいのですが、上手く出来ません。 宜しくお願い致します。 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

専門家に質問してみよう