Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


4870 / 13644 ツリー ←次へ | 前へ→

【53891】選択範囲を指定して一行挿入 Vハチ 08/2/13(水) 21:06 質問[未読]
【53892】Re:選択範囲を指定して一行挿入 りん 08/2/13(水) 21:56 回答[未読]
【53917】Re:選択範囲を指定して一行挿入 Vハチ 08/2/14(木) 22:31 お礼[未読]

【53891】選択範囲を指定して一行挿入
質問  Vハチ  - 08/2/13(水) 21:06 -

引用なし
パスワード
   いつもお世話になっています。

まずマウスで選択範囲を指定します。
その選択範囲でE列を基準に昇順で並び替えをします。
そしてE列の値が下の値と違ったら、一行挿入します。
これを指定した範囲で繰り返します。

並び替えはできました。指定範囲が難しくそして一行挿入も難しいです。

以上よろしくお願いします。

【53892】Re:選択範囲を指定して一行挿入
回答  りん E-MAIL  - 08/2/13(水) 21:56 -

引用なし
パスワード
   Vハチ さん、こんばんわ。

>まずマウスで選択範囲を指定します。
>その選択範囲でE列を基準に昇順で並び替えをします。
>そしてE列の値が下の値と違ったら、一行挿入します。
>これを指定した範囲で繰り返します。

選択範囲のE列を下からチェックして、上のセルの値と違っていたら行を挿入します。
Sub Macro1()
  Dim r1 As Range, Rmin As Long, Rmax As Long, RR As Long
  If Application.Intersect(Selection, Columns("E:E")) Is Nothing Then
   MsgBox "E列を含めて選択してね"
  Else
   Set r1 = Selection
   '範囲の1行目と最下行の番号
   With r1
     Rmin = .Cells(1).Row
     Rmax = .Cells(.Count).Row
   End With
   'E列で昇順ソート
   r1.Sort Key1:=Cells(Rmin, "E"), Order1:=xlAscending, Header:=xlNo, _
       MatchCase:=False, Orientation:=xlTopToBottom
   '下からチェック(比較の繰り返しは2行目まででOK)
   For RR = Rmax To Rmin + 1 Step -1
     If Cells(RR, "E").Value <> Cells(RR - 1, "E").Value Then
      '上と違っていたら行挿入
      Rows(RR).Insert
     End If
   Next
  End If
End Sub

こんな感じです。

【53917】Re:選択範囲を指定して一行挿入
お礼  Vハチ  - 08/2/14(木) 22:31 -

引用なし
パスワード
   無事解決しました。
りんさんありがとうございます。
これからもお世話になると思いますが、どうぞよろしくお願いします。

4870 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free