• ベストアンサー
※ ChatGPTを利用し、要約された質問です(原文:【マクロ】特定の位置から奇数の行を削除する方法)

マクロ初心者必見!奇数の行を削除する方法とは?

このQ&Aのポイント
  • マクロを使って、特定の位置から奇数の行を削除する方法を解説します。具体的な手順や注意点をわかりやすく説明します。
  • 質問者さんは、9列目から奇数の列を削除するマクロの式を知りたいとおっしゃっています。また、グラフの二行目を削除し上詰めたい、表の終わりの列がばらばらで、表の下線も復活させたいという要望があります。
  • さらに、すべてのシートで同じ処理をするためのマクロも知りたいとのことです。マクロ初心者の方にとっては分かりにくい部分もあるかもしれませんが、回答者の方々による丁寧な回答をお待ちください。

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

  • ベストアンサー
  • kagakusuki
  • ベストアンサー率51% (2610/5101)
回答No.1

>(1)グラフの二行目をすべて削除し、上詰めしたいです。 >※9,11,13~と削除していきたい。 という条件から考えますと、 >9列目から、奇数の列を削除する というのは「9行目から、奇数の行を削除する」の間違いではないでしょうか?  同様に >☆1項目2列使っている表を1項目1列にしたい。 というのは「1項目2行使っている表を1項目1行にしたい。」の間違いではないでしょうか?  同様に >(2)このシートの表の終わりは15列目になっていますが、他のシートは25列で終わりだったりとばらばらです。 というのは「(2)このシートの表の終わりは15行目になっていますが、他のシートは25行で終わりだったりとばらばらです。」の間違いではないでしょうか?  それで、 >(3)列を削除した際、表の下線が消えると思います。消した線も復活させたいです。 の条件が非常に面倒で、この条件さえなければ簡単なのですが、必要だと仰るのであれば致し方ありません。  (3)の条件に関しては十分に満たしているとは言い難い(通常は下罫線が消えないのですが、下罫線の色等の設定によっては消えてしまう場合がある)のですが、次の様なマクロは如何でしょうか? Sub QNo8978664_特定の位置から奇数の行を削除する方法() Dim FirstRow As Long, LastRow As Long, FirstColumn As Integer _ , myWidth As Integer, i As Long, c As Range, RefColumn As String Application.ScreenUpdating = False 'モニター表示の更新OFF Application.Calculation = xlCalculationManual '手動計算モードに切り替え RefColumn = "A" '罫線で囲まれているか否かを判定する基準にする列 FirstRow = 9 '削除する行の中で一番上の行 With ActiveSheet.UsedRange '使用されている全てのセルを含んでいるセル範囲 LastRow = .Row + .RowS.Count - 1 '使用されている行の中の最終行 FirstColumn = .Column '使用されている列の中の最終列 myWidth = .Columns.Count '使用されている列の数 End With '「削除する行の中で一番上の行」として設定されている行以下に、使用済みのセルが無ければ処理を中止 If LastRow < FirstRow - 1 Then MsgBox RefColumn & "列の" & FirstRow & "行目以下に表が見つかりません。" _ & vbCrLf & "マクロを終了します。", vbExclamation, "表無し" Exit Sub End If '「使用されている行の中の最終行」と「削除する行の中で一番上の行」の差が奇数行だった場合には最終行を1つ下の行とする LastRow = LastRow - WorksheetFunction.IsOdd(LastRow - FirstRow) For i = LastRow To FirstRow Step -2 '1行おきに処理を行う With Cells(i, FirstColumn).Resize(, myWidth) '処理の対象とするセル範囲を設定 Set c = Range(RefColumn & i) '行削除時に下罫線が消えてしまうのか否かの判定を行う際の基準となるセルを設定 If c.Offset(1).Borders(xlEdgeBottom).LineStyle = xlLineStyleNone _ And c.Borders(xlEdgeBottom).LineStyle <> xlLineStyleNone Then 'セルcに下罫線があり、その1つ下のセルには下罫線が無い場合 For Each c In .Offset() '横1列のセル範囲に含まれているセル1つごとに繰り返し処理 c.Offset(-1).Borders(xlEdgeBottom).LineStyle = c.Borders(xlEdgeBottom).LineStyle '削除予定の行のセルに対して、1つ下のセルの下罫線の線種の設定をコピー c.Offset(-1).Borders(xlEdgeBottom).ColorIndex = c.Borders(xlEdgeBottom).ColorIndex '削除予定の行のセルに対して、1つ下のセルの下罫線の線色の設定をコピー c.Offset(-1).Borders(xlEdgeBottom).TintAndShade = c.Borders(xlEdgeBottom).TintAndShade '削除予定の行のセルに対して、1つ下のセルの下罫線のテーマの色の設定をコピー c.Offset(-1).Borders(xlEdgeBottom).Weight = c.Borders(xlEdgeBottom).Weight '削除予定の行のセルに対して、1つ下のセルの下罫線太さの設定をコピー Next c End If .Delete Shift:=xlShiftUp 'セル範囲を削除し、その下の行を繰り上げる End With Next i Application.Calculation = xlCalculationAutomatic '自動計算モードON Application.ScreenUpdating = True 'モニター表示の更新ON End Sub

tanpopopoketto5
質問者

お礼

早速の回答ありがとうございました。 無事処理ができましたので、お礼申し上げます。

すると、全ての回答が全文表示されます。

関連するQ&A