Excel2002のVBで範囲が減らされる問題の解決方法

このQ&Aのポイント
  • Excel2002のVB記述方法について教えてください。表の特定範囲に登録者氏名を書き込む処理を行っていますが、解約処理を実行すると範囲が減少してしまいます。この問題の解決方法を教えてください。
  • 登録リストの特定範囲に登録者氏名を書き込むVB処理を行っていますが、解約処理を実行すると範囲が減少してしまう問題が発生しています。Excel2002のVB記述方法に詳しい方、解決方法を教えてください。
  • Excel2002のVB記述方法について教えてください。特定範囲への登録者氏名の書き込み処理を行っていますが、解約処理を実行すると範囲が減少してしまう問題が発生しています。解決方法を知っている方、ぜひ教えてください。
回答を見る
  • ベストアンサー

Excel2002のVBで範囲が減らされます

jcb3092で御座います。 Excel2002のVB記述方法についてご教授頂きたくお願い申し上げます。 ここにC5からN157までの表が御座います この中のf5からf157に登録者氏名を書き込みます 登録者合計を 関数 =COUNTIF($F$5:$F$157,"*")でF3に表示 1名の解約処理を実行すると=COUNTIF($F$5:$F$157,"*")の157が156に減っています。 2名なら155と減ります。 この処理を実行しても減らされない記述方法をご教授頂きたくお願い申し上げます。 「 記述内容 」 Sub 解約者リストへ書き込み() Worksheets("登録リスト").Select '前処理を幾つか If Selection.Count > 6 Then MsgBox "解約者1名の氏名を選択してください", , "*****デイケア" Range("B5").Select Exit Sub ElseIf Selection.Column <> 6 Or Selection.Value = "" Then MsgBox "解約者の氏名を選択してください", , "*****デイケア" Exit Sub ElseIf vbOK <> MsgBox(" " & Selection.Value & " 様 の解約処理を行います", vbOKCancel) Then Exit Sub End If '範囲を指定してコピーする Range(Cells(Selection.Row, "C"), Cells(Selection.Row, "n")).Copy _ Destination:=Sheets("解約者リスト").Range("C65536").End(xlUp).Offset(1) '行を削除する Selection.EntireRow.Delete shift:=xlShiftUp '-----(1) End Sub 使用機種:DELL Inspiron6000 OS  :WindowsXP Pro SP3 毎度質問ばかりで申し訳ありません。 よろしくお願い申し上げます。

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

  • ベストアンサー
  • MSZ006
  • ベストアンサー率38% (390/1011)
回答No.1

INDIRECT関数を用いて、 =COUNTIF(INDIRECT("$F$5:$F$157"),"*") のようにするとよいと思います。

jcb3092
質問者

お礼

MSZ006 様 ありがとう御座いました。 確かにINDIRECT関数、使ったことがあります。 表の中に埋め込まれた条件や非表示文字が どのようになるか検証した後ご報告させて頂きます。 ありがとう御座いました。

その他の回答 (1)

  • mt2008
  • ベストアンサー率52% (885/1701)
回答No.2

マクロで行を削除していますからセル式中の範囲も変わります。 行を削除した後、156行目に1行挿入してはどうでしょう。 Selection.EntireRow.Delete Shift:=xlShiftUp '-----(1) の後に↓この1行を追加してみてください。 Rows(156).Insert Shift:=xlDown

jcb3092
質問者

お礼

mt2008 様 早速ありがとう御座いました。 行を削除したためかなとは思いましたが どの様に挿入しようか解りませんでした。 後ほど実行結果をご報告させて頂きます。 ありがとう御座いました。

関連するQ&A

  • EXCEL2002 VBAのループ処理について

    セルB1~B24に入力した数字を i とすると、 コマンドボタンを押したときに、セルB1~B24にの全てに値が入力されていて、 セル( F & i )が空白であれば、そこにセルA1の値を入れるようなマクロを作成しています。 セル( F & i )への入力は、セルB1~B24の全部に数値が入力されており、セル( F & i )が空白があるときのみ処理が実行されるように。どちらかが満たされない場合には、メッセージボックスを表示し、処理しないようにしたいのですが、どうしても途中まで入力されてしまいます。 以下のようなコードですが、何か良い方法はないでしょうか? Private Sub CommandButton1_Click() 'ロール確認 Dim 入力 As String, パレット As String Dim i As Long, t As Long For i = 1 To 24 入力 = Range("B" & i) パレット = Range("F" & i) If 入力 = "" Then MsgBox "aaa" Exit For End If 'パレットNo.転記 If パレット <> "" Then MsgBox "bbb" Exit For ElseIf パレット = "" Then Range("F" & 入力).Value = Range("A1").Value End If Next i End Sub

  • VBA Intersectで範囲の記述

    エクセル2000です。 Intersectで範囲の記述で、名前が定義された範囲、myRng と その2列右どなりを指定したいのですが、 Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Union(Range("myRng"), Range("myRng").Offset(, 2))) Is Nothing Then Exit Sub MsgBox Target.Address End Sub のようにUnionを使わなければできないでしょうか? myRngがA1:A10であれば、 If Intersect(Target, Range("A1:A10,C1:C10")) Is Nothing Then Exit Sub と簡単に記述できるのですが。

  • ExcelVBA With~End With構文でまとめられない??

    すみませんがご教示いただければ幸いです。 セル範囲を選択させ、情報を得てから作業するのですが、コードにたくさんSelection(すべて同じ選択範囲)が出てくるのでWith~End Withでまとめようと思いました。 ところが、まとめてもSelectionという表記を省略できたのはほんのわずかです。 ご覧の通り、TypeName(Selection) をはじめIntersect(Selection(1), 等々省略できないのがほとんどです。 Set myRng=Selection でやったとしても、SelectionがmyRngに変わるだけでぜんぜん省略にならないですよね? こんな場合は何か別の省略した書き方があるのでしょうか? Sub test() With Selection If TypeName(Selection) <> "Range" Then 'セル以外をセレクトしてたら MsgBox "セル範囲を選択してください。", vbCritical, " Σ( ̄ロ ̄lll)" Exit Sub End If If Intersect(Selection(1), Range("D4:AY65")) Is Nothing _ Or Intersect(Selection(.Count), Range("D4:AY65")) Is Nothing Then '指定のセル範囲をはみ出てたら ans = MsgBox("はみ出してますがいいんですか?", vbYesNo + vbQuestion, " ( ̄□ ̄; ? ") If ans = vbNo Then Exit Sub End If End If For Each Ln In ActiveSheet.Lines '配置された各直線につき If Not Intersect(Range(Ln.TopLeftCell, Ln.BottomRightCell.Offset(0, -1)), Selection) Is Nothing Then '選択範囲とかぶってたら MsgBox "重複してます!", vbCritical, " ( ̄□ ̄;)!! " Exit Sub End If Next End With '以下、無関係なので略します。 End Sub

  • 検索後のセルの選択を正しくしたい

    Excel2007でマクロ作成中の初心者です。 以下のコードの中で(1)のところがうまく作動できません。 ここの ActiveCell.Select を正常にするにはどうしたらよいかご教示をお願いします。 Sub 最終日の検索() Dim FC As Range Dim mydate As Date mydate = Range("BQ5").Value For Each FC In Range("BR30:BR300") If FC.Value = DateValue(mydate) Then Exit For End If Next If FC Is Nothing Then MsgBox "みつかりませんここでおわりです" Exit Sub End If MsgBox "見つかりました" & vbLf & FC.Address(0, 0) & vbLf & FC.Value ' ' ここに処理を追加したい ActiveCell.Select ’----------(1) Selection.Offset(0, 45).Select ActiveCell.Select 貼付けしてあるかどうか Set FC = Nothing End Sub ---------------------------------- Sub 貼付けしてあるかどうか() If ActiveCell.Value = "※※" Then MsgBox " 既に貼付けしてあります" Else MsgBox "貼付けしてないので処理します" End If End Sub

  • エクセル2003 特定のセルがブランクの場合

    会社でエクセル2003を使っています。 縦にデータを入力する表を作りました。 (1)氏名 (2)〒 (3)住所 (4)電話番号 (5)生年月日 (6)性別・・・など20項目を入力します。 入力完了後、別シートにデータを転記してそちらの別シートを印刷するというマクロを作りました。 例えば、その中で入力を絶対してほしい項目がありまして、それを忘れていたらメッセージボックスで「○○が未入力です」とお知らせしたいと思ってます。 いろんなサイトで調べてみたのですが…うまくいかなくて… 例文に従って作ってみたのが Sub 円楕円4_Click() Dim Lesson16 As Range Dim 会員名簿 As Worksheet If 会員名簿.Range("A8") = "" Then MsgBox "氏名が記入されていません。" 会員名簿.Range("A8").Select Exit Sub ElseIf 会員名簿.Range("A9") = "" Then MsgBox "住所が記入されていません。" 会員名簿.Range("A9").Select Exit Sub ElseIf 会員名簿.Range("A10") = "" Then MsgBox "年齢が記入されていません。 " 会員名簿.Range("A10").Select Exit Sub ElseIf 会員名簿.Range("A15") = "" Then MsgBox "生年月日が記入されていません。" 会員名簿.Range("A15").Select Exit Sub ThisWorkbook.SaveAs Lesson16 End Sub     です。 家で作ったサンプルなので、セル番号もちょっと???なのですがお許しください。 入力するデータの全てが必須入力項目ではなくて、20項目のうち7項目が必須項目と考えています。 この項目が未入力であれば「未入力ですよ」とお知らせしたいのです。 また、上の例文のセル番号は単独ですが、会社のファイルのセルは結合しています。 (たとえばA8:C8、A15:G15)と行によって結合範囲も違います。 ど素人の質問で、わかりにくいとは思いますが なにとぞ、アドバイスいただきますようよろしくお願いします。

  • エクセル ダブルクリックで処理日の入力

    お世話になります。 先般、お教え頂きました別のダブルクリックイベントプロシージャと 下記の当日の日付を入力するという処理を同じシート上で行いたいのですが、VBエディターにどのように記述したら良いかわかりません。 当方、かなりの初心者です。 よろしくご教授くださいませ。 【新しく加えたい処理】 Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Range("b4:C999")) Is Nothing Then Exit Sub If ActiveCell = "" Then ActiveCell = Date Cancel = True End If End Sub 【もともと使っている処理】 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, Range("h1:h999")) Is Nothing Then With Target If .Value = "" Then .Value = "有" ElseIf .Value = "有" Then .Value = "無" ElseIf .Value = "無" Then .Value = "" End If End With ElseIf Not Intersect(Target, Range("i1:i999")) Is Nothing Then With Target If .Value = "" Then .Value = "要" ElseIf .Value = "要" Then .Value = "不要" ElseIf .Value = "不要" Then .Value = "" End If End With End If End Sub よろしくお願いします。

  • IF文の使い方を教えてください

    もし A5001 に データがあるのなら処理を中止し、データが無ければ処理を継続する。内容のマクロを考えてますが、 A5001にデータがないなら処理を中止は下記の記述で良いかと思いますが、 逆にあったら処理を中止する記述はどうすればよいのですか? Value が怪しいかと思うのですが・・・・ お願いします。 If Range("読み込み!A5001").Value = "" Then MsgBox "データがありません", vbOKOnly, "データ有無確認" Exit Sub End If ret = MsgBox("過去のシュミレーションデータを削除します。よろしいですか?", vbYesNo + vbQuestion, "データ削除実行確認") If ret = vbNo Then Exit Sub End If

  • メッセージBOXの×をクリックしたら中止にする

    いつもお世話になります。 下記のマクロで実行前に、メッセージBOXでYES、NOを聞いていますが、最終的にYESである「消去します」の「OK」をクリックせずに、「×」をクリックしても「消去」を実行します。 これを、「×」をクリックしたら、マクロをキャンセルすることはできないでしょうか? もし、方法が有るなら、下記の記述の「どこに」「どのような」記述を追加したら良いか、ご教授ねがえないでしょうか。 よろしくお願いいたします。 Sub Macro1() ' Macro1 Macro ' If vbYes = MsgBox("出勤・休日のデータを消去してもいいですか?", vbYesNo) Then MsgBox "消去します。" Else MsgBox "中止します。" Exit Sub End If   Range("C4:L34,N4:W34,Y4:AD34,AF4:AK34").Select Selection.ClearContents Range("C4").Select MsgBox "正常に処理を終了しました" End Sub

  • EXCEL2003から2010への互換エラー

    EXCEL2003で使っていたファイルを2010で開いたらコードが反応しなくなりました。 直す方法を教えてください。 具体的にはあるセルに入力すると別シートの「申請書」を印刷するというコードを入れています。 Private Sub worksheet_change(ByVal Target As Excel.Range) Dim h As Range Set h = Application.Intersect(Target, Range("AA15:AA45")) If h Is Nothing Then Exit Sub If h.Cells(1) = "" Then Exit Sub If MsgBox("申請書印刷しますか?", vbOKCancel) <> vbOK Then Exit Sub Worksheets("申請書").PrintOut End Sub よろしくお願いいたします。

  • 【Excel VBA】フォームボタンの操作

    IF文の中でフォームボタンを自動でクリックする処理を追記したく、 以下のコードで実行しましたが、エラーとなりました。 IF文のSubプロシージャが閉まっていないと弾かれたのですが、 どう修正すれば正常に機能しますでしょうか? ここから↓ actsht = ActiveSheet.Name For i = 1 To 12 If actsht = tmp(i) Then Flag = 1 Anser = MsgBox("翌月分シートを作成しますか?", vbYesNo + vbDefaultButton1, "確認") If Anser = vbYes Then ActiveSheet.Copy After:=ActiveSheet ActiveSheet.Name = tmp(i + 1) Sheets(actsht).Tab.ColorIndex = 2 Sheets(actsht).Range("B3").Value = Sheets("Sheet2").Range("A1").Value Sheets(actsht).Range("B4").Value = Sheets("Sheet2").Range("A2").Value ActiveSheet.Range("A2").Select Private Sub clear_Click() '※ End Sub '※ Exit For ElseIf Anser = vbNo Then Exit For End If End If Next

専門家に質問してみよう