日付が同じなら削除する方法を教えてください

前へ 次へ
このQ&Aのポイント
  • ExcelのVBAを使用して、日付が同じ場合に削除する方法を教えてください。
  • A列には日付と時間が記入されており、日付が同じ場合に削除したいです。
  • VBAのコードを使用して、日付が同じ場合に削除する方法を教えてください。
回答を見る
  • ベストアンサー

日付が同じなら削除

すみません、誰か教えて頂けませんでしょうか。 A列に日付と時間が記入されているのですが、日付だけを比較して 同じなら削除したいのですが、誰かご教授頂けませんでしょうか。 A列 2013/8/14 8:00 2013/8/14 8:15 2013/8/14 10:00 2013/8/15 8:00 2013/8/16 8:00 2013/8/17 8:00 2013/8/17 20:00 2013/8/18 8:00 2013/8/18 9:00 A列 2013/8/14 8:00 2013/8/15 8:00 2013/8/16 8:00 2013/8/17 8:00 2013/8/18 8:00 Sub 削除 () Dim r As Long Dim y As Long r = Cells(Rows.Count,1).End(xlUp).Row For y = r To 1 Step -1 If Cells(y,1).Value = Cells(y,1).Offset(1,0) Then 'この比較がわかりません。 Cells(y,1).Offset(1,0).Delete(xlUp) End If Next y End Sub すみませんが、宜しくお願いします。

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

  • ベストアンサー
  • watabe007
  • ベストアンサー率62% (476/760)
回答No.2

参考に Dim r As Long Dim y As Long r = Cells(Rows.Count, 1).End(xlUp).Row For y = r To 2 Step -1 　　If Format(Cells(y, 1), "mm/dd") = Format(Cells(y - 1, 1), "mm/dd") Then 　　　　Cells(y, 1).Delete 　　End If Next y

sabiro
質問者

お礼

watabe007様 ありがとうございます。 参考になりました。

その他の回答 (1)

  • mshr1962
  • ベストアンサー率39% (7418/18948)
回答No.1

参照のVBAの式 If Cells(y,1).Value = Cells(y,1).Offset(1,0) Then 上記だと時間を含んでの比較ですね。　Offset(1,0)は1行下のセルのことです。 日付のみ（シリアル値の整数部分）の比較にするなら If Int(Cells(y,1).Value) = Int(Cells(y,1).Offset(1,0)) Then と値をInt関数かFix関数で整数化すれば可能です。

sabiro
質問者

お礼

mshr1962様 ありがとうございます。 参考になりました。

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • 列を変更して転記したいのですが。

    すみません、誰か教えていただけませんか。 A列に値が入力がされていて、その値をF列に転記していき 15行までいけば２列横にズレて転記していき更に、15行で 2列横と続けたいのですがうまく出来ません。 下記のように記述してみたのですが、値が置き換わるだけで 転記出来ません。 誰か教えて頂けませんでしょうか。 Sub TEST() Dim i As Long, ii As Long Dim myR As Long myR = Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row ii = 5 For i = 1 To myR Cells(1, ii).End(xlUp).Offset(0, 1).Value = Cells(i, 1).Value If Cells(1, ii).End(xlUp).Row = 15 Then ii = ii + 2 End If Next i End Sub 宜しくお願いします。

  • 条件に合った行を削除するマクロについて

    こんにちは 今、現在、とある条件にあった行を削除するマクロ作っているのですが、 インターネットを調べてみると後ろから探索して、1行ずつ消していくのがいいと書いてありました。 まぁ、その理屈はわかるんですが、それなら 「Unionでセルの範囲を結合してから、最後に一度に消してしまった方が速いのでは」 (消す作業が1度だけで済むから) と思い試してみたんですが、実際試したところ・・・ ものすごく遅かったです。 (ちなみに、1万件のデータで削除した行数は6000ほどでした） 何故Union結合だと遅いのでしょうか？ 速いマクロを作成するには、やはり後ろから探索して、1行ずつ消していくしかないのでしょうか？ 以下は試したマクロです。 (test が　unionで試したマクロ、test2が後ろから1行ずつ削除したマクロ) Option Explicit Public Sub test() Dim r As Range Dim r1 As Range 'Cells.Replace "-", " " For Each r In Range("A2", Range("A65536").End(xlUp)) If r = r.Offset(1, 0) And r.Offset(0, 1) < r.Offset(1, 1) Then If r1 Is Nothing Then Set r1 = r Else Set r1 = Union(r1, r) End If End If Next r1.EntireRow.Delete ' r1.Select End Sub Public Sub test2() Dim r As Range Dim r1 As Range Dim i As Integer 'Cells.Replace "-", " " Application.ScreenUpdating = False For i = Range("A65536").End(xlUp).Row To 1 Step -1 If Cells(i, 1) = Cells(i + 1, 1) And Cells(i, 2) < Cells(i + 1, 2) Then Cells(i, 1).EntireRow.Delete End If Next Application.ScreenUpdating = True End Sub

  • msgboxの表示

    Ａ列の値とC列の値をMsgboxに表示するにはどうしたらいいのでしょうか？C列で一番高い商品とその品名A列を表示させたいのですが・・ Sub hinmei() Dim i As Long For i = 2 To Range("C65535").End(xlUp).Row Dim x As Long Dim a As Long x = Cells(i + 1, 5) If Cells(i, 5).Value < x Then a = x End If Next MsgBox a End Sub

  • 連続した値の、間の値を削除したい。

    すみません、誰か教えていただけませんか。 A列に値が入力されていて、連続の値が３つ以上値が連続 していたら間の値を削除したいのですが、どのようにしたら 良いのでしょうか。 すみませんが、教えていただけませんでしょうか。 下記の様に記述しましたが、うまくいきません。 リンゴ 1 リンゴ 2 リンゴ 3 リンゴ 4 ばなな 5 ばなな 6 ばなな 7 みかん 8 みかん 9 みかん 10 みかん 11 パイナップル 12 パイナップル 13 イチゴ 14 イチゴ 15 イチゴ 16 リンゴ 1 リンゴ 4 ばなな 5 ばなな 7 みかん 8 みかん 11 パイナップル 12 パイナップル 13 イチゴ 14 イチゴ 16 Sub 値削除テスト() Dim Te As Long Dim Re As Long Te = Cells(Rows.Count, 1).End(xlUp).Row For Re = 1 To Te If Cells(Re, 1).Value = Cells(Re, 1).Offset(1, 0).Value And Cells(Re, 1).Value = Cells(Re, 1).Offset(2, 0).Value Then Cells(Re, 1).Offset(1, 0).Delete (xlUp) End If Next Re End Sub 宜しくお願いします。

  • インデックスが有効範囲に出ないと出る

    下記のようなVBAを書きました。しかしインデックスが有効範囲にないとメッセージがでるのですが、どこがまちがっているでしょうか？？ Sub macro1() Dim i As Long Dim r As Long Worksheets("フェアリスト ").Select Worksheets("csv").Range("A:C").ClearContents For i = 2 To 50 Step 5 If Worksheets("フェアリスト").Cells(11, i + 1) <> "" Then r = Worksheets("フェアリスト").Cells(65536, i + 1).End(xlUp).Row Worksheets("フェアリスト").Range(Cells(11, i), Cells(r, i + 3)).Copy _ Destination:=Worksheets("csv").Range("B65536").End(xlUp).Offset(1) Worksheets("csv").Range("A65536").End(xlUp).Offset(1).Resize(r - 3, 1).Value = Worksheets("フェアリスト").Cells(8, i).Value End If Next i Worksheets("csv").Range("A1:C1").Delete shift:=xlShiftUp 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 マクロに関しては、素人でございます。 こちらのマクロを作ってみたのですがうまくいきません。 ４列目と１３列目の列が重複したときのみ重複した行をすべて削除させたいと思っております。どうぞお教えください。

  • 連続して同じ値が入ってるなら削除したいのですが

    指定した値なおかつ連続して同じ値が入ってるなら削除したいのですが Ａ列に 紅葉 紅葉 桜 桜 紅葉 とはいっていて、 Sub Sample() Dim i As Long Dim mystr As String mystr = "桜" For i = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1 If Cells(i, 1) = Cells(i - 1, 1) = mystr Then Rows(i).Delete End If Next i End Sub をしても、削除されません。 4行目の桜が削除されてもいいと思うのですが コードのどこが間違えてますか？

  • 重複　印　選択

    選択したセルの列と行にたいしてIFで印を付けていきたいです 引数を選択したセルにしたいのですが下の記述では""の部分に変数を入れてもエラーが出ます 正確な記述方法をご教授いただけると助かります。 また、セルの位置と値の扱い方がいまいちわかってないです。 ご説明をいただけると嬉しいです。 Sub 重複確認() ' 変数宣言 Dim x As Long Dim y As Long x = ActiveCell.Row y = ActiveCell.Column With Range("", Range("" & Rows.count).End(xlUp)) .Offset(, 1).Formula = "=IF(COUNTIF(" & .Address & ",A1)>1,""●"","""")" .Offset(, 1).Value = .Offset(, 1).Value End With End Sub

  • 空白行を削除するマクロ

    空白行を削除するマクロについて質問です。 「Aが空白の場合」ではなく「A～Lセルすべてが空白の場合」に行を削除したいです。 下記のマクロでは、Aが空白の場合に行がすべて削除されてしまいます。 Aが空白でも、BやLに数字や文字があれば、その行は残るようにしたいです。 このマクロをどう変化させれば、うまく作業が実行されますか？ マクロは初心者です。よろしくお願いいたします。 ・・・・・・・・・・・・・・・・・・・・・・・・・・・・ sub macro1() 　dim s as long 　dim e as long 　dim r as long 　s = 5 　e = range("A65536").end(xlup).row 　for r = e to s step -1 　　if application.trim(cells(r, "A")) = "" then 　　　cells(r, "A").entirerow.delete shift:=xlshiftup 　　end if 　next r end sub

  • VBA　sheet2データーから平均取得　sheet1へコピー

    sheet2指定セルデーターから平均 sheet1指定セルに取得したいのですがうまくいきません。 例 sheet1　　　　　　　sheet2 列A　 列B　列C　　列A　 列B　列C １　　２　指定　　１　　２　　３ １　　２　 ３　　 １　　２　　３ １　　２　 ３　　 １　　２　　３ sheet2・列C１～３の平均を、sheet1・指定セルに取得したいのですが Sub test() Dim r As Long, u As Long, ws1 As Object, ws2 As Object, y As Long r = 10 u = 1 Set ws1 = Sheets(1) Set ws2 = Sheets(2) y = ws1.Range("A" & Rows.Count).End(xlUp).Row Dim myAve As Long myAve = Application.WorksheetFunction.Average(ws2.Range(Cells(3, u), Cells(7, u))) ws1.Cells(r, 7).Value = "myAve" r = r + 1 u = u + 1 End Sub 変数y r u を使いfor～nextでデーターを一括取得するつもりなのですが この段階でうまくいきません。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

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

質問する