• ベストアンサー

EXCELマクロ、範囲選択はできたものの・・・

こんにちは。 Wendy02さんはじめ、みなさんのお力をお借りして、 できあがりまじかのグラフですが、恥を承知で教えて ください。 教えてもらったマクロ Sub getMyRange3() Dim r As Range  With ActiveSheet.Range("A1").CurrentRegion    Set r = Cells(65536, .Cells(.Cells.Count).Column).End(xlUp)   Range("A1", r).Select  End With  Set r = Nothing End Sub ****************** ・データ範囲には0が存在する場合がある。 ・末尾データの0は範囲には入れない のことを考慮すると、期待の範囲がとれません。 オートフィルタでの処理も考えましたが、必要な 0までもフィルタされます。 ****************** masa_peeさんの作られたデータサンプルをお借りすると データ的には、    A  B  1 あ 13  2 い  0  3 う 60  4 え 52  5 お  0  6 か  0 というデータのなかで欲しい範囲は、A1からB4です

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

  • ベストアンサー
  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.4

こんにちは。Wendy02です。 #3のgaloon さんへ 実は、ここまで至る話は、 http://oshiete1.goo.ne.jp/kotaeru.php3?q=2019619 (http://okwave.jp/kotaeru.php3?q=2019619) という長い話があって、成立しています。私は、たまたま、そのスレッドの後に書いた者であって、みなさんのおかげで出来上がったものなのです。 つまり、B列であって、B列でないことも考慮してなくてはならないっていうことなのですね。(たぶん……) Do While 1 < r.Row And (IsNull(Cells(r.Row, "B").Value) Or Cells(r.Row, "B").Value = 0) Set r = Cells(r.Row - 1, r.Column) それは、ともかくとして、 tabtab9さんへ 実は、私は、なんとなく、自分の書いたものに満足できていないのです。それは、セルを1つずつ調べるのは、少なくとも、最善手ではありません。それで、猶予を与えていただいたので、もう一度、ご質問を読み直してみて、 >オートフィルタでの処理も考えましたが、必要な0までもフィルタされます。 というのをヒントに作ってみました。この方が、納まりがよく格好が良いし、私らしいコードです。巨大なデータになった時に、おそらく、かなりの速度の違いが出るはずです。うまくいくかは分りませんが。 Sub getMyRange5()   Dim r As Range   Application.ScreenUpdating = False   With ActiveSheet.Range("A1").CurrentRegion    .AutoFilter field:=.Columns.Count, Criteria1:="<>0"    Set r = .Cells(65536, .Columns.Count).End(xlUp)    .AutoFilter    Range("A1", r).Select   End With   Set r = Nothing   Application.ScreenUpdating = True End Sub

tabtab9
質問者

お礼

Wendy02さん、こんばんは。 ヒントになんて・・・ うそでも悪い気がしません。 ぼくにとっては、ある意味 雲の上のひとだったので・・・ ごめんなさいです。ちょっと冷静に なれません。 これからもよろしくお願いいたします。

tabtab9
質問者

補足

>つまり、B列であって、B列でないことも考慮してなくてはならないっていうことなのですね。(たぶん……) すみません。そこまで高尚な考えは持ち合わせていなかったです。分かりやすい例えが例えを生んだ結果です。 ホントにすみませんでした。

その他の回答 (3)

  • galoon
  • ベストアンサー率28% (38/133)
回答No.3

ANo.1 galoon です。 ダメでしたか、失敬。 後学のため全ロジックを一応載せておきます。 Sub getMyRange3() Dim r As Range With ActiveSheet.Range("A1").CurrentRegion Set r = Cells(65536, .Cells(.Cells.Count).Column).End(xlUp) Do While 1 < r.Row And (IsNull(Cells(r.Row, "B").Value) Or Cells(r.Row, "B").Value = 0) Set r = Cells(r.Row - 1, r.Column) Loop Range("A1", r).Select End With Set r = Nothing End Sub では。

tabtab9
質問者

お礼

なんだか、お偉方の登場で完全に僕は 面食らっています。galoonさんも、あ のgaloonさんだし・・・ うれしいのと、申し訳なさでいっぱいです。 どうもありがとうございました。

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.2

こんにちは。Wendy02です。 Sub getMyRange4() Dim rng As Range Dim i As Long Dim c As Range  With ActiveSheet.Range("A1").CurrentRegion   Set rng = .Columns(.Columns.Count)   For i = rng.Rows.Count To 1 Step -1    If rng.Cells(i).Value <> 0 _     And rng.Cells(i).Value <> "" Then     Set c = rng.Cells(i)     Exit For    End If   Next i   If Not c Is Nothing Then   Range("A1", c).Select   End If  End With  Set rng = Nothing: Set c = Nothing End Sub 注:B列まで限定というと、今回のコードは正確ではありません。あくまでも、領域の右端下から検索します。 この手のものは、いくつか案が出てくるはずですから、いくつかご自身のサンプルを作って試してみるとよいですね。後は、疑問に思うことは、ヘルプでチェックしておいたほうがよいです。1度では、とても覚えられないと思いますが、何度か出会うとなんとなく分ってきます。 それと、どういう考え方(ロジック)で作られているか、考えてみるとよいと思います。

tabtab9
質問者

お礼

すごーいです。 わがままな上にわがままを重ねてしまいました。 今度こそ、これで十分です。 ありがとうございました。 うれしいです。 P.S.galoonさんの記述も今、試みています。

tabtab9
質問者

補足

Wendy02さん、すみません。 処理的にはWendy02さんのおかげで、期待の結果を得ることができました。 >この手のものは、いくつか案が出てくるはずですから、 というお話や、”できたのでもういい”、という気持ちは、みなさんに申し訳無いというのと、僕もイヤなので、もうちょっとだけ開けさせてください。

  • galoon
  • ベストアンサー率28% (38/133)
回答No.1

取得した r を元にして B 列の値が 0 であるかぎり r を上にずらしていって 0 以外の値がある一を探してみればいかがですか? Set r = Cells(65536, .Cells(.Cells.Count).Column).End(xlUp) Do While 1 < r.Row And (IsNull(Cells(r.Row, "B").Value) Or Cells(r.Row, "B").Value = 0) Set r = Cells(r.Row - 1, r.Column) Loop ちょっと処理に時間がかかる場合もありますけどね(^^;

tabtab9
質問者

補足

ありがとうございます。 今、実行してみました。 説明不足が原因だと思います。 実行したら、全件が範囲になりました。 申し訳ありません。

関連するQ&A

  • シートを選択した時に実行するマクロについて

    今下記のようにボタンを押したらマクロが実行されるようにしていますが、"退出"というシートを選択した時に実行するようにするにはどの様に書けばいいでしょうか? Private Sub CommandButton1_Click() With Range("A4").CurrentRegion .Cells(.Rows.Count + 1, 1).Select End With End Sub よろしくお願い致します。

  • EXCELマクロのこの記述の意味を教えてください。

    こんにちは。 以前、教えてもらったマクロですが もう少し深く勉強したいので、記述の 意味(翻訳?)を教えてください。 Sub Test5() Dim FR1 As Range, FR2 As Range With ActiveSheet Set FR1 = .Cells.Find( _ "*", , xlValues, xlWhole, xlByRows, xlPrevious) Set FR2 = .Cells.Find( _ "*", , xlValues, xlWhole, xlByColumns, xlPrevious) End With Range("A1", Cells(FR1.Row, FR2.Column)).Select Set FR1 = Nothing: Set FR2 = Nothing End Sub また、この範囲をA列だけを見る場合、つまりA列の最終行を範囲とする場合は、どう記述すればよいのでしょうか? ぜひ、教えてください。

  • VBA AutoFilter 範囲指定

    いつもお世話になっております 過去に https://okwave.jp/qa/q9707059.html にてワークシートのデータをオートフィルターをかけて別なワークシートにデータを取り出す方法を教えて頂きました 送られてくる元データが変更になって、A3セルの上のA2セルの上にテキスト文字が入るようになったので、範囲指定を正しく出来るようにする方法を https://okwave.jp/qa/q9708868.html にて教えて頂きました 今回、https://okwave.jp/qa/q9707059.htmlで教えて頂いたワークシートのコードを実行させると元データが変更になったデータを利用すると、A1セルまで含まれた範囲がAutoFilter の領域と判断される為正しい結果となりません 添付画像のワークシートで Sub test9() Worksheets("Sheet1").Range(Cells(3, "A"), Cells(Range("A3").CurrentRegion.Rows.Count, Range("A3").CurrentRegion.Columns.Count)) _ .AutoFilter Field:=2, Criteria1:=Cells(5, "G").Value End Sub を実行させれば、"秋田”でフィルターがきちんとかけれらた状態になります そこで教えて頂いたコードを下記に変更して実行させてみたのですが Dim i As Long With Worksheets("Sheet1") .Range("B4", .Range("B4").End(xlDown)).Copy .Range("G4").PasteSpecial (xlPasteAll) .Range("G4", .Range("G4").End(xlDown)).RemoveDuplicates Columns:=Array(1), Header:=xlNo For i = 4 To .Cells(Rows.Count, "G").End(xlUp).Row Worksheets.Add After:=Worksheets(Worksheets.Count) ActiveSheet.Name = .Cells(i, "G").Value .Range(Cells(3, "A"), Cells(Range("A3").CurrentRegion.Rows.Count, Range("A3").CurrentRegion.Columns.Count)) _ .AutoFilter Field:=2, Criteria1:=.Cells(i, "G").Value .Cells(3, 1).CurrentRegion.Copy Destination:=Worksheets(.Cells(i, "G").Value).Cells(3, 1) .AutoFilterMode = False Next .Range(Cells(3, "A"), Cells(Range("A3").CurrentRegion.Rows.Count, Range("A3").CurrentRegion.Columns.Count)) _ .AutoFilter Field:=2, Criteria1:=.Cells(i, "G").Value 部分で 実行時エラー'1004' アプリケーション定義またはオブジェクト定義のエラーです になってしまいます 元データがA2セルにテキスト文字が入った状態でも正常にコード動作させるにはどのようにしたらいいのでしょうか よろしくお願い致します

  • 印刷範囲を設定するvbaコード

    エクセルシートの印刷範囲を設定するvbaコードで Sub Macro1() With ActiveSheet.PageSetup .PrintArea = "$A$1:$c$10" End With End Sub としてるのですが、 "$A$1:$c$10"の部分を Range(Cells(1, 1), Cells(10,3)) 形式でやりたいのですが、 うまくできません。 Sub Macro1() With ActiveSheet.PageSetup .PrintArea = Range(Cells(1, 1), Cells(10,3)) End With End Sub としても、全部が印刷範囲として選択されてしまいます。 というか、印刷範囲が設定されません。

  • excel 文字抽出マクロの編集についてですが・・・

    マクロで指定した文字を含むデータを抽出するマクロを 作っていたのですが、うまく作動しません。 どこが悪いか教えてください。 Sub 指定した文字データの抽出() Dim strMoji As String strMoji = InputBox("検索文字を入力してください") strMoji = "*" & strMoji & "*" Sheets("Sheet2").Activate Cells.Clear With Sheets("Sheet1") .Range("A2").AutoFilter Filde:=3, criterial:=strMoji .Range("A2").CurrentRegion.Copy _ Destination:=Sheets("Sheet2").Range("A2") .Range("A2").AutoFilter End With Sheets("Sheet2").Columns("A:D").AutoFit End Sub

  • Excelマクロ オートフィルター条件設定で不等号を使いたい

    Excelマクロ オートフィルター条件設定で不等号を使いたい 請求シートより抽出条件シートに条件を設定し、抽出シートにコピーするマクロ を作成しています。 抽出条件に比較演算子の不等号<>を使った場合、条件が無視されてしまいます。 どのようにしたら良いでしょうか? 請求シートのA列には会社番号が数字4桁で入力されています。 抽出条件シートA5セルに下記の条件を設定した場合、 1と2の場合は上手くフィルターが機能しますが、3の不等号を 使った場合は機能しません。どなたか宜しくお願いします。 1:1000 2:>1000 3:<>1000 Sub テスト() Dim LastRow As Long, LastColumn As Long Dim myData As Range Dim myCriteria As Range With Worksheets("請求") LastColumn = .Cells(5, Application.Columns.Count).End(xlToLeft).Column LastRow = .Cells(Application.Rows.Count, "A").End(xlUp).Row Set myData = .Range("A5", .Cells(LastRow, LastColumn)) End With Set myCriteria = Worksheets("抽出条件").Range("A5").CurrentRegion Worksheets("抽出").Range("A6:R1000").ClearContents myData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=myCriteria, _ CopyToRange:=Worksheets("抽出").Range("A5:R5"), Unique:=False Set myData = Nothing Set myCriteria = Nothing End Sub

  • エクセル マクロ 教えてください。

    sheet1に (a1=No. b1=月日 C1=項目 d1=収入 e1=支出 f1=摘要 G1=店名)項目を作りそれらをユーザーフォームを作り入力したいです。 この記述では上手く動けません。教えてください。 Private Sub CommandButton1_Click() Dim r As Long, 最終行 As Long, 項目行 As Long Dim re As String r = textboxs1.Value + 10 最終行 = Worksheets("入力").Range("B65536").End(xlUp).Row If r <= 最終行 Then re = MsgBox("訂正" & " " & "すでにデータが入力されています。" & Chr(13) & _ Chr(13) & "データを置き換えます。 本当に良いですか? ", _ Buttons:=vbYesNo + vbExclamation, Title:="注意!!") If re = vbYes Then With Worksheets("入力") .Cells(r, 2).Activate .Cells(r, 1).Value = TBox1.Value .Cells(r, 2).Value = TBox2.Value .Cells(r, 3).Value = ComboBox1.Value .Cells(r, 4).Value = TBox3.Value .Cells(r, 5).Value = TBox4.Value .Cells(r, 6).Value = TBox5.Value .Cells(r, 7).Value = ComboBox2.Value End With データクリア Exit Sub End If データクリア Exit Sub End If If r >= 最終行 + 1 Then r = 最終行 + 1 End If With Worksheets("入力") .Cells(r, 1).Value = TBox1.Value .Cells(r, 2).Value = TBox2.Value .Cells(r, 3).Value = ComboBox1.Value .Cells(r, 4).Value = TBox3.Value .Cells(r, 5).Value = TBox4.Value .Cells(r, 6).Value = TBox5.Value .Cells(r, 7).Value = CBomboox2.Value End With データクリア End Sub r = データNo + 10 With Worksheets("入力") .Activate .Cells(r, 2).Select TBox1.Value = .Cells(r, 1).Value TBox2.Value = .Cells(r, 2).Value ComboBox1.Value = .Cells(r, 3).Value TBox3.Value = Format(.Cells(r, 4).Value, "###,###") TBox4.Value = Format(.Cells(r, 5).Value, "###,###") TBox5.Value = .Cells(r, 6).Value ComboBox2.Value = .Cells(r, 7).Value End With Exit Sub End If If データNo > 最終行 - 10 Then データNo = 最終行 - 9 TBoxNo.Value = データNo データクリア End If End Sub

  • エクセルののマクロについて教えてください

    Sub search() Dim i As Long, lastCol As Long, c As Range, str As String, wS As Worksheet Set wS = Worksheets("sheet2") wS.Cells.Clear str = Application.InputBox("検索内容を入力") Application.ScreenUpdating = False With Worksheets("sheet1") lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column .Columns(lastCol + 1).Insert For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row Set c = Range(.Cells(i, "A"), .Cells(i, lastCol)).Find(what:=str, LookIn:=xlValues, lookat:=xlWhole) If Not c Is Nothing Then .Cells(i, lastCol + 1) = 1 End If Next i If WorksheetFunction.CountIf(.Columns(lastCol + 1), 1) > 0 Then .Range("A1").AutoFilter field:=lastCol + 1, Criteria1:=1 .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy wS.Range("A1") wS.Columns.AutoFit wS.Columns(lastCol + 1).Delete wS.Activate .Columns(lastCol + 1).Delete .AutoFilterMode = False Else MsgBox "該当データなし" End If End With Application.ScreenUpdating = True End Sub エクセルで上のシステムをネットから持ってきました。 上から5行目のinputboxを"Sheet3"のA列からデータを持ってきてプルダウンで表示させたいのですがユーザーフォームでオブジェクトを組まないで表示させる方法を教えてください

  • エクセル マクロ range

    rangeの使い方が分かりません. 特にグラフの範囲指定の方法で・・・ 1..  r1=range("cells(28,RETU1)")  ? RETU1、RETU2は、inputboxで指定したい。 2. r2=range("cells(28,RETU1),cells(295,RETU2") ? 3. range("a28,a295","cells(28,RETU1),cells(295,RETU2").select ? 離れた範囲2つを一つの範囲にしたグラフを書きたい。 4.  inputboxで列名を記入するとき、数字でないといけないのか、アルファベットでもいいのですか? 5. range("cells(28,RETU1)").activate ? 以上を別法で以下のようにしたら? 6.  Dim r1 As RANGE ・・・となって、Rangeになりません。   このあと、例えば、 r1.select とかr1.activateでいいですか? 7. set R1=range("cells(28,RETU1),cells(250,RETU2") set R2=range(a28,a250) unite (R1,R2) ?

  • Excel マクロ 別ブックの情報をコピーする方法

    他のブックの情報をコピーして貼り付けるマクロを作成しています。 2種類のブックから情報をコピーして貼り付けます。 Sub MailTemp() Dim myCellall As Range Dim myCellyoso As Range Dim myCellfor As Range Set myCellall = Sheets("すべて").Range("A3") With Workbooks.Open("\") With .Worksheets("すべて") .Range(.Range("A3"), .Cells.SpecialCells(xlCellTypeLastCell)).Copy myCellall End With .Close False End With Set myCellyoso = ThisWorkbook.Worksheets("予測").Range("A3") Set myCellfor = ThisWorkbook.Worksheets("結果").Range("A3") With Workbooks.Open("\別ブック") With .Worksheets("予測") .Range(.Range("A3"), .Cells.SpecialCells(xlCellTypeLastCell)).Copy myCellyoso End With With .Worksheets("結果") .Range(.Range("A3"), .Cells.SpecialCells(xlCellTypeLastCell)).Copy myCellfor End With .Close False End With End Sub 下記の箇所でエラーが発生して、先に進みません。 原因を調べていましたが、わかりません。 Set myCellfor = ThisWorkbook.Worksheets("結果").Range("A3") エラーメッセージ 実行時エラー'9' インデックスが有効範囲にありません。 アドバイスを頂けますでしょうか。 よろしくお願いいたします。

専門家に質問してみよう