• ベストアンサー

VBAについて

皆様、こんにちは。 VBAを使って会計シートを作っていますが、初心者なので、色々と悩んでいます。今回、コンボボックスにセールをリンクして、コンボボックスで選ばれた値に合わせてシートの行を増やしたいですが、どうすればいいでしょうか?例えば、linked cellは2の場合は、 Range("D25:G27").Select Selection.Insert Shift:=xlDown 3の場合は Range("D25:G28").Select Selection.Insert Shift:=xlDown などのようにしたいですが、誰か詳しい方が教えてくだされば非常に助かります。どうぞよろしくお願いいたします。

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

  • ベストアンサー
  • fujillin
  • ベストアンサー率61% (1594/2576)
回答No.2

No1です。 >IcValueとはなんですか? 値がどこにあるのか不明でしたので、その内容(数値)がlcValueという変数に取り込まれていると仮定して… という意味で適当に作成した変数名です。(回答文をもう一度読んでいただければ、意味が通じると思います) ご提示の補足を見たところ、E28の値のようですので、  IcValue = Range("E28").Value としておけば後半はそのまま使用できるでしょう。 ところで、ご提示のマクロの前半はコンボボックスを作成するマクロになっていますが、このマクロだと、マクロを走らせるたびに新しいコンボボックスが作成されることになりますけど…? (同じ位置に作成されるので、重なって見た目は一つに見えますが) 想像するところ、コンボボックスは手動でひとつだけ作成しておいて、マクロには不要ではないのでしょうか?

lyu05665
質問者

お礼

fujillin様、ご丁寧に教えていただいてどうもありがとうございました。おかげさまで行を増やす方法などについて理解できました。少しイメージと違って、結局全体のフォームの形を考え直す必要があることがわかりました。大変勉強になりました。

全文を見る
すると、全ての回答が全文表示されます。

その他の回答 (2)

  • DOUGLAS_
  • ベストアンサー率74% (397/534)
回答No.3

.LinkedCell = "$E$28" で Range("D25:G26").Insert Shift:=xlDown とされたのでは、せっかくの「.LinkedCell」が下方向へ下がってしまって、参照できなくなりますので、「.LinkedCell 」は「"D25:G25"」より下には置かないようにして、例えばそのアドレスを「"$K$22"」とすると、下記のようなことになります。 Sub コンボボックス設置()  ActiveSheet.DropDowns.Add(263.25, 310.5, 54.75, 15).Select  With Selection   .ListFillRange = "$K$23:$K$25"   .LinkedCell = "$K$22"   .DropDownLines = 8   .Display3DShading = False  End With End Sub Sub 行の挿入()  Dim MyRows As Byte  MyRows = Application.WorksheetFunction.Index(Range("$K$23:$K$25"), Range("$K$22").Value)  Range("D25").Resize(MyRows + 1, 4).Insert Shift:=xlDown End Sub

lyu05665
質問者

お礼

DOUGLAS_様、ご指摘やプロシージャの説明をどうもありがとうございました。確かに、LinkedCellの位置が間違っていました。 なるほど、行を変数にすればいいですね。ありがとうございました!

全文を見る
すると、全ての回答が全文表示されます。
  • fujillin
  • ベストアンサー率61% (1594/2576)
回答No.1

ご提示以外の変数などが不明ですので… lcValueに対象となる値(2~3?)が入っていると仮定して、ベタで書くなら  If lcValue=2 Then   Range("D25:G27").Insert Shift:=xlDown  ElseIf lcValue=3 Then   Range("D25:G28").Insert Shift:=xlDown  End If みたいな感じ? 必ず挿入する行があって、規則性があるなら   Range("D25:G" & (25 + lcValue)).Insert Shift:=xlDown  (lcValueは0以上の整数) という方法もあります。

lyu05665
質問者

補足

fujillin様、答えてくださってどうもありがとうございます。本当に初心者で申し訳ありませんが、IcValueとはなんですか? 次のように書いてみましたが、うまく動きません。まだ、足りないところがあるでしょうか? ActiveSheet.DropDowns.Add(263.25, 310.5, 54.75, 15).Select With Selection .ListFillRange = "$K$23:$K$25" .LinkedCell = "$E$28" .DropDownLines = 8 .Display3DShading = False End With If IcValue = 1 Then Range("D25:G26").Insert Shift:=xlDown ElseIf lcValue = 2 Then Range("D25:G27").Insert Shift:=xlDown ElseIf lcValue = 3 Then Range("D25:G28").Insert Shift:=xlDown End If End Sub

全文を見る
すると、全ての回答が全文表示されます。

関連するQ&A

  • VBAマクロエラー【オーバーフローしました。】

    以下のVBAマクロで突然エラーが出るようになってしまいました。 原因がわからず困っています。 どなたかご教授ください。 該当部分 :S = Range("B2").End(xlDown).Row エラーMrg:実行時エラー'6': オーバーフローしました ----------マクロ文---------- Sub 部担コード読み替え() Dim R_Count As Integer Dim P_Sheet As String Dim S As Integer 'データ取込用のファイルを開く Workbooks(D_Book).Activate Sheets("Data1").Select Columns("C:C").Select Selection.Insert Shift:=xlToRight Range("B2").Select S = Range("B2").End(xlDown).Row Range("C2:C" & S).Formula = "=SUBSTITUTE(SUBSTITUTE(RC[-1],""%"",""1""),""*"",""2"")" Range("C1").Value = "部担コード" Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues Columns("B:B").Select Application.CutCopyMode = False Selection.Delete Shift:=xlToLeft Range("A1").Select Sheets("Data2").Select Columns("C:C").Select Selection.Insert Shift:=xlToRight Range("B2").Select S = Range("B2").End(xlDown).Row Range("C2:C" & S).Formula = "=SUBSTITUTE(SUBSTITUTE(RC[-1],""%"",""1""),""*"",""2"")" Range("C1").Value = "部担コード" Columns("G:G").Select Selection.Insert Shift:=xlToRight Range("G2:G" & S).Formula = "=SUBSTITUTE(SUBSTITUTE(RC[-1],""%"",""1""),""*"",""2"")" Range("G1").Value = "キー" Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues Columns("B:B").Select Application.CutCopyMode = False Selection.Delete Shift:=xlToLeft Columns("E:E").Select Application.CutCopyMode = False Selection.Delete Shift:=xlToLeft Range("A1").Select End Sub

  • ExcelのVBAです。

    先日お答えいただいたVBAなんですが、 Sub Macro1() Sheets("Sheet1").Select Range("A1").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("Sheet3").Select Range("A1").Select ActiveSheet.Paste Selection.End(xlDown).Select Application.CutCopyMode = False Do Selection.Insert Shift:=xlDown Selection.End(xlUp).Select Loop Until ActiveCell.Address = "$A$1" End Sub というのを使用させて頂いてます。 これを、コピー先のものを上書きせずに、コピーされたものがあれば表示させるといった風に出来ないでしょうか? 例  A    A 1 a 1 2 b → 2あ 3 c 3 右から左に一行間隔で別シートに表示させたいのですが、  A  1 a 2 あ 3 b 4 5 b という結果にしたいのです。 拙い文章で申し訳ないのですが、教えて頂きたいです。

  • エクセルのマクロ実行→オブジェクトがはみでるエラーについて

    エクセルでマクロを作り、実行したのですが、データを集計し「2」で集約する部分で「オブジェクトからはみでます」というエラーがでます。原因がわかりません。正しく実行できる方法を教えてください。 Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(3, 4, 5, 6, _ 7, 8, 10, 13), Replace:=True, PageBreaks:=False, SummaryBelowData:=False Range("D2").Select   ↓この部分でエラーになります。 ActiveSheet.Outline.ShowLevels RowLevels:=2 Range("A2").Select Selection.Insert Shift:=xlDown Range("P2:R2").Select Selection.Insert Shift:=xlDown Range("B1").Select Selection.SpecialCells(xlCellTypeVisible).Select Selection.Copy

  • 行を挿入するマクロがうまくいきません。

    Sheets("りんご").Select Rows("1:1").Select Selection.Copy Sheets("みかん").Select Range("人").Select Selection.Insert Shift:=xlDown Application.CutCopyMode = False End Sub というマクロは、りんごのシートにある1行をコピーして、 みかんのシートの人と名前定義してある特定の行にコピーする マクロです。この次に下のマクロを実行すると Sheets("りんご").Select Rows("2:3").Select Selection.Copy Sheets("みかん").Select Range("人").Select Selection.Insert Shift:=xlDown それまでのものが残ってしまい、行がどんどん増えていってしまいます。 いずれかのマクロを実行すればリセットされて行が増えないように コピーするにはどうすればよいでしょうか・・?

  • エクセルVBAの保存

    毎月異なった新しいエクセルファイルに同じような加工を施すため、VBAを書きました。対象はActivesheetとしています。 で、質問は、この新しいエクセルファイルの標準モジュールにいちいちこのVBAをコピーペーストせずに実行する方法です。 きっと何かあるとは思うのですが・・・・。 VBAは次のような簡単なものです。 Sub 加工1() Dim e As Integer, s As String, n As String e = Range("A4").End(xlDown).Row s = Replace(Mid(Range("A2"), 8, 5), "年", "") & "-" n = Replace(Mid(Range("A2"), 19, 5), "年", "") & "-" Range("A1:C2").MergeCells = False Columns("B:B").Select Selection.Insert Shift:=xlToRight Columns("A:A").Select Selection.Insert Shift:=xlToRight Columns("C:C").Select Selection.NumberFormatLocal = "G/標準" Range("B3").Select Selection.AutoFill Destination:=Range("B3:C3"), Type:=xlFillDefault Range("B3").Select ActiveCell.FormulaR1C1 = "商品番号1" Range("C4").Select ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],10)" Range("C4").Select Selection.AutoFill Destination:=Range("C4:C" & e), Type:=xlFillDefault Range("A3").Select ActiveCell.FormulaR1C1 = "抽出年月日" Range("A4").Select ActiveCell.FormulaR1C1 = s & n & 1 Range("A4").Select Selection.AutoFill Destination:=Range("A4:A" & e), Type:=xlFillDefault Rows("3:3").Select Selection.Insert Shift:=xlDown Range("B1:E1").MergeCells = True Range("B2:E2").MergeCells = True ActiveSheet.Name = "提出用" End Sub

  • 'Cells'メソッドは失敗しました '_Global'オブジェクト

    次のマクロですが、順調に動いていたと思うと 急にタイトルのエラーで落ちたりします。 Set mySh = Thisworkbook.Sheets("Sheet1") Debug.Print mySh.Cells(1,1) また、そのときは・・・ mySh.Rows("4:4").Select Selection.Insert Shift:=xlDown や mySh.Select Rows("4:4").Insert Shift:=xlDown や mySh.Rows("4:4").Insert Shift:=xlDown もできなくなります。 オブジェクトへの参照方法が今ひとつわかっていないのですが、 どの場合でもエラーなく実行するにはどうすればいいのでしょうか?

  • マクロでシート2~6のデータをシート1に転記したい

    マクロでシート2~6のデータをシート1に転記したいです。 シート2~6のデータを シート1に順番に転記したくてマクロの記録を利用して作成しました。 シート2~6は列は同じですが行数は異なります。 また行数は作業の都度異なります。 同じ記述が繰り返されているので もう少し記述が短くできるのではと思うのですが どうすればいいでしょうか? Sub データ更新() 'シート1の前回データをクリア Sheets("シート1").Select Range("A2:Q2").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents Range("A2").Select Sheets("シート1").Select Range("A1").Select Sheets("シート2").Select Range("A1").Select 'ヘッダーも合わせて取得 Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート3").Select Range("A2").Select 'データのみ取得 Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート4").Select Range("A2").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート5").Select Range("A2").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート6").Select Range("A2").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select End Sub

  • sheet1上のマクロでsheet2に画面を切り替えずに行を挿入させたい

    Excel2002ユーザーです。 sheet1上で実行するマクロで、画面を切り替えることなく、 いわば水面下でsheet2の行1に空行を挿入させ、常に最新のデータ(Sheet1上にあるセルの値)を書き込んでいく、 ということをしたいのです。 古いデータは順次、下に送られる形です。 まずデータの書き込み以前に、挿入ができないのです。 sheet1上のマクロで、 Worksheets("sheet2").Rows("1:1").Select Selection.Insert Shift:=xlDown と書き込みましたがダメでした。 (実行時エラー'1004': RangeクラスのSelectメソッドが失敗しました) Sheets("sheet2").Select Rows("1:1").Select Selection.Insert Shift:=xlDown の場合、行挿入はOKですが、sheet2に画面が切り替わってしまいます。 常にsheet1の画面を表示させたままにしてこのようなことを行いたいのですが、 良きアイデア、アドバイスがありましたら御教授ください。 よろしくお願い致します。

  • VBA進捗状況を可視化(数値)で

    お願いします。いま以下の作業をかりに1000回繰り返し、なおかつ その進捗状況を可視化(数値で)する一番簡単な記述は どのように書けばいいのでしょうか。実行の順番も併せて VBA上級者の方、よろしくお願いいたします。 Sub 移動() ' ' 移動 Macro Range("D6:D15").Select Selection.Copy Range("H6").Select ActiveSheet.Paste Columns("G:G").Select Application.CutCopyMode = False Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("C2").Select End Sub

  • VBA 400エラー 1004エラー

    以下のVBAはセルのカット&ペーストをしたり、置換をするプログラムです。 しかし、EXCEL2003であれば通常に動作するのですが、 EXCEL2000だと400エラーや1004エラーが出てしまいます。 原因を探求するもよく分からなかったため、ご教示いただけば幸いです。 Sub 一ページ17名標準() Application.ScreenUpdating = False ActiveSheet.Unprotect Range("A1").Select Cells.Find(What:="No.2").Offset(-1, 36).Resize(3, 8).Insert Shift:=xlDown Cells.Find(What:="No.2").Offset(-1, 2).Resize(3, 1).EntireRow.Delete Rows("2:61").RowHeight = 21.75 '''行の幅 変更点 Cells.Find(What:="No.1").Offset(-1, 2).Resize(3, 1).EntireRow.Copy Range("38:38").Insert '''No2見出し挿入カ所 変更点 Range("A39").Replace What:="No.1", Replacement:="No.2" '''No1→No2置換カ所 変更点 Cells.Find(What:="No.2").Offset(-1, 36).Resize(3, 8).Delete Shift:=xlUp Cells.Find(What:="♯管理欄").Resize(3, 8).Activate ' ' '名字のエクセル関数の調整(全共通) Selection.Cut Range("AK63").Select Selection.Insert Shift:=xlDown Cells.Find(What:="♯管理欄").Resize(3, 8).Activate Selection.Cut Range("AK38:AS40").Select Selection.Insert Shift:=xlDown Range("A1").Select ActiveSheet.Protect Application.ScreenUpdating = True End Sub 宜しくお願いします。

専門家に質問してみよう