EXCEL VBAで作成したスクロールバーの不具合を修正する方法

このQ&Aのポイント
  • EXCEL VBAで作成したスクロールバーの不具合を修正する方法について教えてください。
  • スクロールバーの上部1/5程度でデータが終わってしまう問題について、データ数に合わせて修正することは可能でしょうか。
  • 現在試してみたが原因がわからず、解決方法が知りたいです。
回答を見る
  • ベストアンサー

EXCEL VBAで作成したスクロールバーの不具合を修正したいのですが

ちょっと言葉だと説明しにくいのですが、教えていただきたいことがあります。 EXCEL VBAでスクロールバーを作成したのですが、 スクロールバーの上部1/5程度で全部のデータが終わってしまいます。 データ数に合わせて、スクロールした一番最後に最後のデータが来るように修正することは可能でしょうか。 自分で色々試してみましたが原因がさっぱりわかりませんでした。 作成したマクロは以下のとおりです。 *シート「一覧」のA列~D列×3000行のデータを入力  シート「リスト」にスクロールバーを設置 Private Sub ScrollBar1_Change() currow = ScrollBar1.Value Call smpscrollbar End Sub Private Sub Workbook_Open() currow = 3 With Sheets("リスト").ScrollBar1 .Min = 3 .Max = Sheets("一覧").Range("A1").CurrentRegion.Rows.Count End With Call smpscrollbar End Sub Sub smpscrollbar() With Sheets("リスト") .Range("B1").Value = Sheets("一覧").Range("A" & currow).Value .Range("E1").Value = Sheets("一覧").Range("B" & currow).Value .Range("I1").Value = Sheets("一覧").Range("C" & currow).Value .Range("N1").Value = Sheets("一覧").Range("D" & currow).Value End With End Sub

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

  • ベストアンサー
回答No.1

.Max = Sheets("一覧").Range("A1").CurrentRegion.Rows.Count の行の後に Sheets("一覧").Range("A1").CurrentRegion.select または MsgBox .Max を加えて、CurrentRegionや.maxが何になっているか確認してみてはどうでしょうか? 思わぬ値になっていたら、 .Max = Sheets("一覧").UsedRange.Rows.Count .Max = Sheets("一覧").Cells(Sheets("一覧").Rows.Count, 1).End(xlUp).Row(A列の最後の行) .Max = Sheets("一覧").Cells(65536, 1).End(xlUp).Row(Sheets("一覧").Rows.CountはExcel2007以前では65536なので) .Max = Debug.Print Sheets("一覧").Range("A65536").End(xlUp).Row(CellをRangeにした場合) とかに変更するといいかもしれません。

takohasisa
質問者

お礼

End(xlUp)でMAXを調整する手がありましたか! ありがとうございました。早速試してみます。

関連するQ&A

  • エクセル スクロールバー Min/Max値

    ちょっとズレていたら申し訳ありません。教えてください。 エクセル「コントロールツールボックス」の「スクロールバー」にあるMinとMaxを 特定のセルにリンクさせたいのですが、どのようにすればよいでしょうか? 現在、下記でMinの値とリンクセルを試していますが、なかなか動きません。 Private Sub Worksheet_Calculate() ScrollBar1.LinkedCell = Range("A1") ScrollBar1.Min.Value = Range("A2") End Sub 教えてください。お願いします。

  • Excel VBAで作成するスクロールバーの応用について

    EXCEL VBAで作成するたスクロールバーについて教えていただきたいことがあります。 Sheets("Bar")にスクロールバーを設置し、 Sheets("List")のA列のデータをSheets("Bar")のRange("A1")に表示 Sheets("List")のB列のデータをSheets("Bar")のRange("B1")に表示 この場合、Sheets("List")にオートフィルタを設定してデータを抽出したとして、 抽出されたデータだけをSheets("Bar")のスクロールバーで表示させることは可能でしょうか。   A列   B列 1行:東日本  青森 2行:西日本  大阪 3行:東日本  茨城 4行:西日本  山口 5行:東日本  東京 6行:西日本  福岡 オートフィルタを設定し、A列を”東日本で抽出” 1行:東日本  青森 3行:東日本  茨城 5行:東日本  東京 Sheets("Bar")のスクロールバーをスクロールすると Range("A1")に"東日本","東日本","東日本" Range("B1")に"青森","茨城","東京" と表示される。 そもそもそんなことが出来るのかどうかも含めて、 どんな式でやったらいいのかも私のスキルでは全く思い浮かびません。 よろしくお願いいたします。

  • VBAでスクロールバーを動かしても値が変わらない

    図のようなスクロールバーを動かして、それぞれの値と、A4のセルの色が変わるものを作りたいのです。 プログラムは、 Sub スクロール1_Change() R = Range("C2").Value G = Range("D2").Value B = Range("E2").Value Range("A4").Interior.Color = RGB(R, G, B) End Sub Sub スクロール2_Change() R = Range("C2").Value G = Range("D2").Value B = Range("E2").Value Range("A4").Interior.Color = RGB(R, G, B) End Sub Sub スクロール3_Change() R = Range("C2").Value G = Range("D2").Value B = Range("E2").Value Range("A4").Interior.Color = RGB(R, G, B) End Sub ですが、スクロールバーに関連付けられていないようです。基本ですみませんが、関連付けるにはどうすればいいのでしょうか。

  • VBAコンボボックスの内容が反映されない

    超初心者で、申し訳ございません。下記のようなコードを入力しましたが、 プルダウンは動くのですが、選択することが出来ません。誤りを指摘していただきたく、ご教授の程よろしくお願いします。 Private Sub UserForm_Initialize() With MainForm.ComboBox1 .List = Sheets("data").Range("A2:A11").Value .ListIndex = 0 End With Private Sub ComboBox1_Change() With MainForm.ComboBox1 .List = Sheets("data").Range("A2:A11").Value .ListIndex = 0 End With End Sub

  • VBAスクロールを規制する

    Private Sub Workbook_Open() Sheets("Sheet1").ScrollArea = "A1:AK23" End Sub 上記のコードでA1からAK23までしか選択できないようにしてスクロールを止めてるのですが、 range("BZ24").value="あ" range("BZ24").select を実行した場合、bz24には「あ」と言う文字が入力され、選択されますか? また、選択された時でも画面はA1:AK23から動かないですよね?

  • コンボボックスのvba 作成の仕方

    私は、月別にデータを作っています。なので、月ごとにデータを見られるようなボタンを作成したいです。 現在組んでいるマクロは、ボタン(普通の四角いもの)を押すごとに、翌月データをコピペするというものになっています。 (以下、現在のコード記載) Sub auto_open() Dim wkm As Long Dim wkn As Long Dim wkt As Variant Dim wks As Variant Dim dt As Date Dim mi As Integer dt = Date mi = Month(dt) wkt = Array(0, 10, 11, 12, 1, 2, 3, 4, 5, 6, 7, 8, 9) wks = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12) wkm = wkt(mi) Call Macro1(wkm) Sheets("住宅資金").Range("A3") = wks(mi) End Sub Sub Next_Month() Dim wks As Variant Dim dt As Date Dim mi As Integer wks = Array(0, 10, 11, 12, 1, 2, 3, 4, 5, 6, 7, 8, 9) If Sheets("住宅資金").Range("A3") = 12 Then wkm = 10 Else wkm = wks(Sheets("住宅資金").Range("A3") + 1) End If Call Macro1(wkm) wks = Array(0, 4, 5, 6, 7, 8, 9, 10, 11, 12, 1, 2, 3) Sheets("住宅資金").Range("A3") = wks(wkm) End Sub Sub Macro1(ByVal wkm As Long) With Sheets("入力") Sheets("住宅資金").Range("D5:D23").Value = .Range("C5:C23").Offset(, wkm - 1).Value Sheets("住宅資金").Range("J5:J23").Value = .Range("C28:C46").Offset(, wkm - 1).Value Sheets("住宅資金").Range("P5:P23").Value = .Range("T28:T46").Offset(, wkm - 1).Value Sheets("住宅資金").Range("O5:O23").Value = .Range("T5:T23").Offset(, wkm - 1).Value Sheets("住宅資金").Range("F5:F23").Value = .Range("O5:O23").Value Sheets("住宅資金").Range("L5:L23").Value = .Range("O28:O46").Value End With With Sheets("目標") Sheets("住宅資金").Range("C5:C23").Value = .Range("B4:B22").Offset(, wkm - 1).Value Sheets("住宅資金").Range("I5:I23").Value = .Range("B27:B45").Offset(, wkm - 1).Value End With With Sheets("前年同期") Sheets("住宅資金").Range("H5:H23").Value = .Range("C5:C23").Offset(, wkm - 1).Value Sheets("住宅資金").Range("N5:N23").Value = .Range("C28:C46").Offset(, wkm - 1).Value Sheets("住宅資金").Range("Q5:Q23").Value = .Range("T5:T23").Offset(, wkm - 1).Value End With End Sub さて、現在作りたいと思っているものを以下に記述します。 普通の四角いボタンではなく、コンボボックスを使用して、矢印(▼)を押すことによってリストが表れ、 「1月」に合わせたら1月のデータがコピペされる、「8月」に合わせたら8月のデータがコピペされる、というものを作りたいと思っています。 以下のような空欄の表を作成したシートがあります。        A    B    C   D 1      目標  実績  …   … 2 ○支所   3 △支所 4  ・ 5  ・ 6  ・ 別のシートに、手入力した月別のデータがあります。 空欄のシートのどこかにコンボボックスを作り、別シートの○月のデータを貼り付けられるようにしたいと思っています。 コンボボックスの作り方がわからず、後一歩のところでつまずいてしまいました。 知恵をお貸しください。 よろしくお願いいたします。

  • EXCEL VBA エラーの意味が分からず

    いつも、お世話になっております。 下記コードで、レコード1と2を前へと次へを繰り返し何度か操作すると、エラーになってしまいます。なぜエラーになって、どう修正すれば回避できるのかが分かりません。 どうかご教授いただけないでしょうか。よろしくお願いいたします。 エラーの状況 inputシートで、maeとtsugiの動作を何度か行うと、「If pict.TopLeftCell.Address = targetRange.Address Then」の部分が黄色く塗りつぶされ、「実行時エラー1004 アプリケーション定義またはオブジェクト定義のエラーです。」と表示されてしまします。たぶん写真の削除の時にエラーになっているのだと思いますが、 '■標準モジュールのコード。dataシートのレコードを移動し、inputシートのBC1セルに表示する。 Public trg As Range Sub Saisyo() Set trg = Worksheets("data").Range("A1") Do Set trg = trg.Offset(1, 0) Loop Until trg.EntireRow.Hidden = False Call Tenki End Sub Sub Saigo() Set trg = Worksheets("data").Range("A60000").End(xlUp) Call Tenki End Sub Sub Mae() On Error GoTo errhandle If trg.row >= 3 Then Do Set trg = trg.Offset(-1, 0) Loop Until trg.EntireRow.Hidden = False If trg.row = 1 Then MsgBox "これより前のレコードはありません" Call Saisyo Exit Sub Else Call Tenki End If Else MsgBox "これより前のレコードはありません!" End If Exit Sub errhandle: Call Saisyo End Sub Sub Tsugi() On Error GoTo errhandle If trg.row < Worksheets("data").Range("A60000").End(xlUp).row Then Do Set trg = trg.Offset(1, 0) Loop Until trg.EntireRow.Hidden = False Call Tenki Else MsgBox "これより後ろのレコードはありません" End If Exit Sub errhandle: Call Saigo End Sub Sub Tenki() Worksheets("input").Range("BC1").Value = trg.Offset(0, 0) End Sub '■sheet 1のモジュール。inputシートBC1セルの値を見て、dataシートへ値を読みにいき、inputシートへ表示する。 Private Sub hyouji() Dim fRange As Range Dim kensaku As Long Set fRange = Sheets("data").Columns(1).Find(What:=Range("BC1").Value, _ LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows) If (fRange Is Nothing) Then '見つからなかった? MsgBox "入力された顧客コードが存在しません。", vbExclamation Exit Sub End If kensaku = fRange.row '検索された顧客DCの行位置を求める Range("BC1:BE1").Value = Sheets("data").Cells(kensaku, 1).Value '整理No Range("AX1").Value = Sheets("data").Cells(kensaku, 2).Value '固有ID Range("I4").Value = Sheets("data").Cells(kensaku, 3).Value '工場名 Range("P4").Value = Sheets("data").Cells(kensaku, 4).Value '柱No Range("W4").Value = Sheets("data").Cells(kensaku, 5).Value '盤No Range("I5").Value = Sheets("data").Cells(kensaku, 6).Value '変台系統1 Range("S5").Value = Sheets("data").Cells(kensaku, 7).Value '変台系統2 Range("I6").Value = Sheets("data").Cells(kensaku, 8).Value '分電盤設置時期 Range("B8").Value = Sheets("data").Cells(kensaku, 9).Value '主な供給先 Range("B14").Value = Sheets("data").Cells(kensaku, 10).Value '特記 Range("AD4").Value = Sheets("data").Cells(kensaku, 11).Value '盤位置の目安 Range("AT8").Value = Sheets("data").Cells(kensaku, 12).Value '幹線線相 Range("R36").Value = Sheets("data").Cells(kensaku, 13).Value '盤写真ファイル名 Range("AT36").Value = Sheets("data").Cells(kensaku, 14).Value '単結図ファイル名 End Sub '■sheet 1のモジュール。"$R$36"と"$AT$36"の写真ファイル名を見て、"C37"と"AE37"セルに表示させる。 Private Sub Worksheet_Change(ByVal Target As Range) Dim fRange As Range Dim touroku As Long Select Case Target.Address Case "$BC$1" Call hyouji Case "$R$36" myLoadPicture "board_Image", Target.Text, Range("C37") Case "$AT$36" myLoadPicture "map_Image", Target.Text, Range("AE37") Case "$AT$8" Call red_circle Case Else Exit Sub End Select End Sub Private Sub myLoadPicture(folderName As String, fname As String, targetRange As Range) Dim pict As Shape, picPath As String picPath = ThisWorkbook.Path & "\" & folderName & "\" & fname If fname = "" Then picPath = ThisWorkbook.Path & "\" & folderName & "\" & "NoImage.jpg" End If With ActiveSheet For Each pict In .Shapes If pict.TopLeftCell.Address = targetRange.Address Then pict.Delete Exit For End If Next pict Set pict = .Shapes.AddPicture(picPath, msoTrue, msoFalse, _ targetRange.Left, targetRange.Top, 300, 360) End With End Sub

  • エクセルVBA

    VBAの素人です。 以下のようなVBAを実行しようと、何とか形にしました。 単独のBOOKではうまくいくのですが、同時に他のBOOKを開くと 「インデックスが有効範囲にありません」とエラーになります。 エラー箇所は、With Sheets("Sheet1").Range("B1")部分です。 修正をご教示頂ける方、何卒よろしくお願い致します。 全くVBA無知なのにすみません。 Private Sub Workbook_Open() test01 test02 Application.OnTime Now + TimeValue("00:10:00"), "終了" End Sub Sub 終了() Application.OnTime Now + TimeValue("0:00:02"), "test01", , False ThisWorkbook.Close Savechanges:=False Application.Quit End Sub Sub test01() With Sheets("Sheet1").Range("B1") .Value = Time .NumberFormatLocal = "mm:ss" End With Application.OnTime Now + TimeValue("0:00:02"), "test01" End Sub Sub test02() With Sheets("Sheet1").Range("B2") .Value = Time .NumberFormatLocal = "mm:ss" End With End Sub

  • エクセルVBAで(続)

    前日も質問(http://okweb.jp/kotaeru.php3?q=1480399)を出していたものですが、続きがあります。下記は今現在のコードです。 Sub 得意先追加()  Sheets("一覧").Unprotect Dim myRng As Range, a Sheets("新規").Copy before:=Sheets(4) With ActiveSheet .Unprotect 得意先シート登録.Show .Name = .Range("A4").Value & .Range("A3").Value .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True   Set myRng = Sheets("一覧").Range("A65536").End(xlUp).Offset(1) myRng.Value = .Range("A4").Value & .Range("A3").Value Sheets("一覧").Hyperlinks.Add _ Anchor:=myRng, _ Address:="", _ SubAddress:=myRng.Value & "!A1", _ TextToDisplay:=myRng.Value End With Sheets("一覧").Select Range("A4").Activate Selection.End(xlDown).Select ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True End Sub 実は一覧シートのA列はコード&得意先名ですが、B列には今期の売上合計(各得意のシートのP10をリンク貼付),D列には前期の売上合計(各得意先のP9よりリンク貼付)があります。 それで,得意先追加を実行しているときに一覧シートのB列・D列にシートの各セルをリンク貼付するにはということなんですが、教えていただけますでしょうか。 宜しくお願いします。

  • エクセル VBAについて。

    Private Sub ComboBox2_Change() On Error Resume Next With Me.ComboBox2 If .ListCount < 0 Then Exit Sub If .Value = "" Then Exit Sub Me.Range("K45").Value = _ Worksheets("マスタ").Range(.List(.ListIndex, 1)).Offset(0, 2).Value Me.Range("K48").Value = _ Worksheets("マスタ").Range(.List(.ListIndex, 1)).Offset(0, 4).Value End With End Sub これをマスタのU列とW列を表示したい場合、どこを変えれば良いのでしょうか? 今はD列とF列が表示されております。

専門家に質問してみよう