アプリ版:「スタンプのみでお礼する」機能のリリースについて

マクロを組んでほしい。。。
下記のようなマクロを組みたいのですが
思ったようにいきません。
どなたがご教授いただけないでしょうか。。。


◎やりたいこと1
シート1の2行目、項目名"削除"をFindで探し、
そのひとつ下のセルから最下部までコピー
シート1の2行目、項目名"会社名"をFindで探し、
そのひとつ下のセルから貼り付ける

◎やりたいこと2
シート1の2行目、項目名"契約番号"の列と
シート1の2行目、項目名"締結日"の列を比べ、
"解約日"の列の空白のセルに"2099/3/31"をいれる
(項目名"契約番号"の列と同じ列まで"2099/3/31"を項目名"締結日"にいれる)

◎やりたいこと3
シート1の2行目、項目名"契約番号"で
空白になっている行は全て削除する


宜しくお願い致します!!

質問者からの補足コメント

  • うーん・・・

    tom04さん

    いつもありがとうございます!
    やりたいこと1.2はばっちりでした(゜_゜>)


    やりたいこと3に関して、
    実行時エラー424
    オブジェクトが必要ですというエラーが出てしまいました、、、

    下記に元々私が使っていたコードを記載します。。。
    このB列が項目名"契約番号"にあたるのですが
    B列から動く可能性があり、
    項目名で探し出してから下記のような処理をしたいなと考えております。

    Columns("B").SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete

      補足日時:2018/04/11 10:01
  • うーん・・・

    ご回答ありがとうございます。

    エラーは見当たらないのですが
    思った動きと違う動きになりました(T_T)
    やりたかったこととしては、
    契約番号の列で空白になっているセルの列を削除するみたいな動きだったのですが
    このコードだとちょっと違う動きをしてます()
    (最初は動いたのですがもう一度実行しようとしたらエラー、オブジェクト変数、withブロック変数が設定されていませんというエラーが出てきました。。。)

    No.3の回答に寄せられた補足コメントです。 補足日時:2018/04/11 10:41

A 回答 (4件)

>契約番号の列で空白になっているセルの列を削除するみたいな動きだったのですが・・・



列ではなく「行削除」ですよね?
違う動きとはどういった動きなのかこちらでは判らないのですが、
とりあえず↓のマクロを実行してみてください。
(当然のコトですが、2行目項目の中に「契約番号」という項目がある!という前提です。)

Sub Sample2()
Dim c As Range, lastRow As Long
Set c = Rows(2).Find(what:="契約番号", LookIn:=xlValues, lookat:=xlWhole)
lastRow = Cells(Rows.Count, c.Column).End(xlUp).Row
Range(Cells(3, c.Column), Cells(lastRow, c.Column)).SpecialCells(xlCellTypeBlanks).EntireRow.Select
End Sub

「契約番号」列で空白セルがあればその行がすべて選択されているはずです。

これで選択範囲が間違いないのであれば
>Range(Cells(3, c.Column), Cells(lastRow, c.Column)).SpecialCells(xlCellTypeBlanks).EntireRow.Select

>On Error Resume Next
>Range(Cells(3, c.Column), Cells(lastRow, c.Column)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
に変更してみてください。

「契約番号」列に空白セルがない場合はエラーになりますので
>On Error Resume Next
を追加しています。m(_ _)m
    • good
    • 0

No.1・2です。



No.2のコードも間違いがありました。

>Range(Cells(3, myR.Column), Cells(lastRow, myR.Column)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

>Range(Cells(3, c.Column), Cells(lastRow, c.Column)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

になりますね。m(_ _)m
この回答への補足あり
    • good
    • 1

No.1です。



「やりたいこと2」で「契約番号」の列番号と最終行(lastRow)を取得し
「やりたいこと3」でそのまま列番号と最終行を使用していますので、
前回のコードは別々のマクロにするとエラーになる可能性があります。

もし別々のマクロにするのであれば
「やりたいこと3」でもう一度「契約番号」の列番号と最終行を取得する必要があると思います。

「やりたいこと3」のコードを↓にしたらどうなりますか?

Set c = Rows(2).Find(what:="契約番号", LookIn:=xlValues, lookat:=xlWhole)
lastRow = Cells(Rows.Count, c.Column).End(xlUp).Row
On Error Resume Next '//←念のため//
Range(Cells(3, myR.Column), Cells(lastRow, myR.Column)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    • good
    • 1

こんにちは!



「やりたいこと2」がイマイチよくわからないのですが・・・

Sub Sample1()
Dim lastRow As Long
Dim c As Range, r As Range, myR As Range

'//やりたいこと1//
Set c = Rows(2).Find(what:="削除", LookIn:=xlValues, lookat:=xlWhole)
Set r = Rows(2).Find(what:="会社名", LookIn:=xlValues, lookat:=xlWhole)
lastRow = Cells(Rows.Count, c.Column).End(xlUp).Row
Range(Cells(3, c.Column), Cells(lastRow, c.Column)).Copy
r.Offset(1).PasteSpecial Paste:=xlPasteValues

'//やりたいこと2//
Set myR = Rows(2).Find(what:="契約番号", LookIn:=xlValues, lookat:=xlWhole)
lastRow = Cells(Rows.Count, myR.Column).End(xlUp).Row
Set c = Rows(2).Find(what:="解約日", LookIn:=xlValues, lookat:=xlWhole)
Set r = Rows(2).Find(what:="締結日", LookIn:=xlValues, lookat:=xlWhole)
On Error Resume Next '//←念のため★//
Range(Cells(3, c.Column), Cells(lastRow, c.Column)).SpecialCells(xlCellTypeBlanks).Value = "2099/3/31"
Range(Cells(3, r.Column), Cells(lastRow, r.Column)).SpecialCells(xlCellTypeBlanks).Value = "2099/3/31"
'//やりたいこと3//
Range(Cells(3, myR.Column), Cells(lastRow, myR.Column)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

こんな感じでよいのでしょうかね?m(_ _)m
    • good
    • 1

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!