なぜか正常にマクロが動いていない？

前へ 次へ
このQ&Aのポイント
  • エクセルのマクロを使用して、セルの内容を集約する作業を行っています。
  • しかし、B列以降の最後の行が集約されない現象が発生しています。
  • 特に、B列以降にある「--------」という記述が最後の行で集約されずに省略されることがあります。
回答を見る
  • ベストアンサー

なぜか正常にマクロが動いていない？

Sub 横から縦へ() Dim ii As Long, i As Long Application.ScreenUpdating = False For ii = 2 To Cells(1, Columns.Count).End(xlToLeft).Column i = Application.CountA(Columns(ii)) If i > 0 Then Cells(1, ii).Resize(i).Copy Cells(Rows.Count, 1).End(xlUp).Offset(1) End If Next ii Application.ScreenUpdating = True End Sub こちらは、B列からある記入をA列の下へと集約させるマクロです。 これで、横にずっとあるセル達をA列の縦に集約していました。 ですが、なぜかB列以降の最後の行が集約されません。 B列からずっと右の列の最後には、 ----- -------- という記述があります。（-----と--------の間に２セル開け） 上記のマクロで、 ----- -------- を集客させると、 ----- が最後になり、 -------- が集約されません。 ２セル開いてるからかと思い、セルを開けずにマクロを動かしたら、 -------- が省略されて、集約されました。 まるで、 -------- を避けているかのようです。 -------- これが入らないとならないのですが、省略されると困ります。 -------- これもちゃんと集約されるようにするには、どのようにすればよいでしょうか？ エクセル2016です。 よろしくお願いいたします。

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

  • ベストアンサー
  • kkkkkm
  • ベストアンサー率65% (1620/2460)
回答No.1

----- -------- の間が空白でしたら i = Application.CountA(Columns(ii)) に正しいセルの数が入っていないと思います。 Cells(1, ii).Resize(i). で.Resize(i)が正しい範囲をとらえられていないのではないでしょうか。 以下のようにしてみてはいかがでしょう i = Cells(Rows.Count, ii).End(xlUp).Row Range(Cells(1, ii), Cells(i, ii)).Copy Cells(Rows.Count, 1).End(xlUp).Offset(1)

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

関連するQ&A

  • 列幅が変更されるエリアデータでの平均値取得方法

    excel2010 B6セルから*6(*の列はデータの数により変更されます）までのデータ平均をマクロで *+1の列に記述しようとしています。 B6からBI6までデータがあればBJ6セルでAVERAGE(B6:BI6)と表記したいということです。 マクロでは Range("BJ6") = "=AVERAGE(B6:BI6)" です。 方法としては、データを貼り付けた最終列の１つ右の列にセルをもっていき、 B6から*6までの平均を記述しようとしています。 '最終列の１つ右のセル列選択 Cells(6, Columns.Count).End(xlToLeft).Offset(0, 1).Select Range(Cells(6, Columns.Count).End(xlToLeft).Offset(0, 1).Address) = "=AVERAGE(B6:Cells(6, Columns.Count).End(xlToLeft).Address)" で実行すると実行時エラー1004　アプリケーション定義またはオブジェクト定義のエラーです というエラーが表示されます。 何が 間違っているのでしょうか？ Range(Cells(6, Columns.Count).End(xlToLeft).Offset(0, 1).Address) = "=AVERAGE(B6:BI6)" を実行すると、 BJ6セルに=AVERAGE(B6:BI6) と表示されたので、 BI6に相当する部分は、 Cells(6, Columns.Count).End(xlToLeft).Address で表せると思うのですが…。

  • マクロ　検索範囲を修正したい　1つ置きのセルで

    前に以下のマクロをここで教えていただきました。このときはB列からF列の範囲でお願いしたのですが、F列～AG列の1つ置きのセル（G、I、K・・・列）で検索したいです。どう修正したらよいですか？初心者なので調べても分からなかったので教えてください。 Sub Sample1() 'この行から Dim i As Long, j As Long, vL vL = InputBox("検索値を入力してください。") Application.ScreenUpdating = False Cells.Interior.ColorIndex = xlNone For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row For j = 2 To 5 With Cells(i, j) If .Value <> "" And .Value >= vL - 3 And .Value <= vL + 3 Then .Interior.ColorIndex = 36 End If End With Next j Next i Application.ScreenUpdating = True 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 'この行まで

  • エクセルマクロFor Eachの処理が長い

    エクセル2013です。 皆さんに教えていただいて以下のマクロが完成しました。 サンプルデータ ３０行、7列ではあっという間に処理ができたのですが 本番環境 800行、50列ですと 処理時間が長く 青丸がくるくる回っていて、2分後にくらいで終わります。 もう少し早く処理する方法はありますでしょうか？ Findで検索して、一括削除？ （それはマクロでできるのでしょうか？） よろしくお願いします。 Sub 出荷済削除() Dim 対象セル As Range Dim 対象色 As Long Dim 対象色2 As Long Dim 最終行 Dim 最終列 最終列 = Cells(8, Columns.Count).End(xlToLeft).Column '8行目の最終列を取得 最終行 = Cells(Rows.Count, 1).End(xlUp).Row 'A列の最終行を取得 Application.ScreenUpdating = False '画面切替停止 対象色 = Range("B8").Interior.Color 'セルB8の色を基準色とする 対象色2 = Range("A8").Interior.Color 'セルB8の色を基準色とする For Each 対象セル In Range(Cells(10, 17), Cells(最終行, 最終列)) If 対象セル.Interior.Color = 対象色 Or 対象セル.Interior.Color = 対象色2 Then 対象セル.ClearContents Next 対象セル Application.ScreenUpdating = True '画面切替停止解除 End Sub

  • マクロで教えてください。

    sheet1のA列にある図番を参照しsheet2のA列の機種名に適合する行全体に sheet1のB列にある色を塗りたいのですが、マクロを教えていただけますでしょうか？ sheet2のBのセル色を塗るマクロはわかりました。↓です。 Sub macro1() Dim c As Range, myR As Variant With Sheets("Sheet2") For Each c In .Range("a2", .Cells(Rows.Count, "a").End(xlUp)) myR = Application.Match(c.Value, Sheets("sheet1").Columns(1), 0) If Not IsError(myR) Then c.Offset(, 1).Interior.ColorIndex = Sheets("sheet1").Cells(myR, "B").Interior.ColorIndex End If Next End With End Sub 上記マクロですとBセルのみ色が塗られてしまうので行全体を塗るマクロを教えてください。 よろしくお願い致します。

  • 置換のマクロ

    すみません、基礎的なことかもしれませんが、 調べてもわかりませんでした… 下記マクロで、今はwS1のA列に置換したい文字があった場合 置換をしてくれますが、 A列だけではなく、wS1のシート全体を指定する為にはどのように書き換えればいいでしょうか…？ Replace(wS1.Cells(i, "A"), wS2.Cells(k, "A") の　wS1.Cells(i, "A")　を　Aではなく、シート全体の指定に変えたいのです。。 Sub 置換() Dim i As Long, k As Long, wS1 As Worksheet, wS2 As Worksheet Set wS1 = ActiveSheet Set wS2 = Worksheets("置換") Application.ScreenUpdating = False For i = 1 To wS1.Cells(Rows.Count, "A").End(xlUp).Row For k = 1 To wS2.Cells(Rows.Count, "A").End(xlUp).Row If InStr(wS1.Cells(i, "A"), wS2.Cells(k, "A")) > 0 Then wS1.Cells(i, "A") = Replace(wS1.Cells(i, "A"), wS2.Cells(k, "A"), wS2.Cells(k, "B")) End If Next k Next i Application.ScreenUpdating = True End Sub 過去の質問↓の回答にあったマクロから、少し変えて使わせていただいています。 http://okwave.jp/qa/q8293972.html

  • エクセルののマクロについて教えてください

    Sub search() Dim i As Long, lastCol As Long, c As Range, str As String, wS As Worksheet Set wS = Worksheets("sheet2") wS.Cells.Clear str = Application.InputBox("検索内容を入力") Application.ScreenUpdating = False With Worksheets("sheet1") lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column .Columns(lastCol + 1).Insert For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row Set c = Range(.Cells(i, "A"), .Cells(i, lastCol)).Find(what:=str, LookIn:=xlValues, lookat:=xlWhole) If Not c Is Nothing Then .Cells(i, lastCol + 1) = 1 End If Next i If WorksheetFunction.CountIf(.Columns(lastCol + 1), 1) > 0 Then .Range("A1").AutoFilter field:=lastCol + 1, Criteria1:=1 .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy wS.Range("A1") wS.Columns.AutoFit wS.Columns(lastCol + 1).Delete wS.Activate .Columns(lastCol + 1).Delete .AutoFilterMode = False Else MsgBox "該当データなし" End If End With Application.ScreenUpdating = True End Sub エクセルで上のシステムをネットから持ってきました。 上から5行目のinputboxを"Sheet3"のA列からデータを持ってきてプルダウンで表示させたいのですがユーザーフォームでオブジェクトを組まないで表示させる方法を教えてください

  • For Nextマクロの高速化についてご教示ください。

    エクセル2000です。 以下は、ワークシートのA列の２行目以降に赤（Interior.ColorIndex = 3 ）のセルがあればその行を非表示に、１行目のA列以降に赤いセルがあればその列を非表示にする単純なマクロです。通常はストレスなく動いてくれるのですが、あるBOOKにこのマクロを設定したら、わずか200行程度の処理に1分以上かかってしまいました。 そのBOOKは1.4MBあるのでそのせいとも思えるのですが、それにしても時間がかかりすぎるような気もします。 高速化する方法がありましたらご教示くださいませ。 (o。_。)oペコッ Private Sub 行列非表示() Application.Calculation = xlCalculationManual Application.ScreenUpdating = False With ActiveSheet x = .Cells(1, 1).SpecialCells(xlLastCell).Row y = .Cells(1, 1).SpecialCells(xlLastCell).Column For i = 2 To x If .Cells(i, "A").Interior.ColorIndex = 3 Then .Rows(i).Hidden = True End If Application.StatusBar = i Next i For n = 1 To y If .Cells(1, n).Interior.ColorIndex = 3 Then .Columns(n).Hidden = True End If Application.StatusBar = n Next n End With Application.StatusBar = "" Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Exit Sub End Sub

  • マクロについて

    マクロ初心者です。 下記の操作をマクロで行いたいのですがうまくいかないのでどうすればうまくマクロが作動するのか教えて頂ければと思います。4の操作までは正しく作動しましたが5以降に困っています。。。 どなたかお願いしますｍｍ (1) Ａ列にフィルターをかけて[??????}を含むものを選択 (2). 1に.該当するもＢ列のＤａｔａを値のみ数値と値のClear (3) 2の後に再びＡ列で[??????]を含まないものを選択 (4)　　3に該当するＡ列のＤａｔａを数値と値のＣｌｅａｒ (5)　　4の操作で空白となったセルに＝上のセルという計算式の指示を出す (6) すべて値貼り付けをし、空白のセルを削除する ※Ｄａｔａの行数は毎回作業時に変更があります。 ※Ｄａｔａは数値だけではなく文字列も含んでいます 失敗したマクロ--------------------------------------------- Range("A2").Select Selection.AutoFilter Field:=1, Criteria1:="=*[??????]*", Operator:=xlAnd Columns("B:B").Select Selection.ClearContents Selection.AutoFilter Field:=1, Criteria1:="<>*[??????]*", Operator:=xlAnd Columns("A:A").Select Selection.ClearContents For i = 3 To [A65536].End(xlUp).Row If Cells(i, "A") = "" Then Cells(i - 1, "A").Copy Cells(i, "A") Next i End Sub -----------------------------------------------------------

  • マクロについて

    マクロ初心者です。 下記の操作をマクロで行いたいのですがうまくいかないのでどうすればうまくマクロが作動するのか教えて頂ければと思います。4の操作までは正しく作動しましたが5以降に困っています。。。 どなたかお願いしますｍｍ (1) Ａ列にフィルターをかけて[??????}を含むものを選択 (2). 1に.該当するもＢ列のＤａｔａを値のみ数値と値のClear (3) 2の後に再びＡ列で[??????]を含まないものを選択 (4)　　3に該当するＡ列のＤａｔａを数値と値のＣｌｅａｒ (5)　　4の操作で空白となったセルに＝上のセルという計算式の指示を出す (6) すべて値貼り付けをし、空白のセルを削除する ※Ｄａｔａの行数は毎回作業時に変更があります。 ※Ｄａｔａは数値だけではなく文字列も含んでいます 失敗したマクロ--------------------------------------------- Range("A2").Select Selection.AutoFilter Field:=1, Criteria1:="=*[??????]*", Operator:=xlAnd Columns("B:B").Select Selection.ClearContents Selection.AutoFilter Field:=1, Criteria1:="<>*[??????]*", Operator:=xlAnd Columns("A:A").Select Selection.ClearContents For i = 3 To [A65536].End(xlUp).Row If Cells(i, "A") = "" Then Cells(i - 1, "A").Copy Cells(i, "A") Next i End Sub -----------------------------------------------------------

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

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

質問する