インプットボックスのキャンセル処理で型が一致しないエラーが発生する

このQ&Aのポイント
  • インプットボックスのキャンセルを押したときに「型が一致しません」というエラーが表示される問題が発生しています。
  • 調査した結果、エラーの原因が分かりませんでした。アドバイスをいただけると助かります。
  • Excel VBAのコードを使用して指定した行数を挿入する処理を行っていますが、正常に動作しないため、解決策を教えてください。
回答を見る
  • ベストアンサー

インプットボックスのキャンセル処理

インプットボックスのキャンセルを押したときに「型が一致しません」というエラーがでてしまいます。いろいろ調べてみてはいるのですが分かりません。教えて下さい。 Sub 指定した行数を挿入() Dim TopRow As Integer, CntRow As Integer, InstRows As Integer Dim i As Integer, ii As Integer, n As Integer Sheets("Sheet1").Select Rows("7:7").Select TopRow = ActiveCell.Row CntRow = Selection.Rows.Count n = InputBox("行数を入力して下さい。", "指定した行の挿入") If n = "" Then Exit sub End if InstRows = n For i = 1 To CntRow Rows(TopRow + (i - 1) * (InstRows + 1)).Select For ii = 2 To InstRows Selection.EntireRow.Insert Next ii Next i End Sub

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

  • ベストアンサー
  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.1

InputBoxメソッドならFalseを返すのでnをValiant型で宣言して、 Dim n As Variant n = Application.InputBox("行数を入力して下さい。", "指定した行の挿入") If n = False Then Exit Sub とかをよく使います。 ご参考程度に。

noa8998
質問者

お礼

お礼遅くなり申し訳ありません。 ありがとうございました。

その他の回答 (1)

  • ShowMeHow
  • ベストアンサー率28% (1424/5027)
回答No.2

Dim n As Integer If n = "" Then これが、エラーの原因です。 Dim n as String InstRows = Val(n) とすれば、とりあえず動くと思います。

noa8998
質問者

お礼

お礼遅くなり申し訳ありません。 ありがとうございました。

関連するQ&A

  • VBAで行を挿入する

    VBAを始めた初心者です。 Exel2002使用です。 VBAでA列の4行目から10行目に行の挿入をできるようにしようと下記のように書きましたが、Rows("i:i").Selectの部分でデバックがかかってしまいます。間違っている理由がわからないのですがよろしくお願いします。 また、DO While Loopステートメントを使ってA列が空白になるまで(例えばA4セル以下の)行を挿入とする場合の方法も教えていただけましたら幸いです。 Sub 4行目から10行目まで() Dim i As Integer For i = 4 To 10 Cells(i, 1).Value = i Rows("i:i").Select Selection.Insert Shift:=xlDown Next i End Sub Sub 4行目から空白になるまで() Dim i As Integer Range("A4").serect Do While activecell.value = "" Cells(i, 1).Value = i Rows("i:i").Select Selection.Insert Shift:=xlDown activecell.offset(1,0).select Loop End Sub

  • 型が一致しません

    下記はセルが0の時、行全体を表示しないにするようにするVBAですが、型が一致しませんとエラーになります、どこを直せばいいのですか。 Dim I As Integer Sub Macro4() For I = 4 To 76 If Cells(I, 8) = 0 Then Rows("I:I").Select Selection.EntireRow.Hidden = True End If Next I End Sub

  • やはり図形のクリアで実行時エラー1004

     図形を二行三列で一枡とし図形を貼り付けていますが、どうしても実行時エラー 「1004」が出て図形のクリアができません。(尚、四角形は枠線上にあります。) 対処法がありましたらお願いします。 Windows7・SP1 Office2010 Sub 図形の貼付け() Dim i As Integer Dim j As Integer For i = 10 To 43 Step 2 For j = 9 To 99 Step 3 Select Case Cells(i, j).Value Case 1: ActiveSheet.Shapes("四角形1").Select Selection.Copy Cells(i + 1, j + 1).Select ActiveSheet.Paste Case 2: ActiveSheet.Shapes("四角形2").Select Selection.Copy Cells(i + 1, j).Select ActiveSheet.Paste Case 4: ActiveSheet.Shapes("四角形3").Select Selection.Copy Cells(i + 1, j + 1).Select ActiveSheet.Paste Case 5: ActiveSheet.Shapes("四角形3").Select Selection.Copy Cells(i + 1, j + 2).Select ActiveSheet.Paste Case 6: ActiveSheet.Shapes("円1").Select Selection.Copy Cells(i, j).Select ActiveSheet.Paste End Select Next Next End Select End Sub Sub 図形のクリア() Dim myRng As Range Set myRng = Range("I10:CW43") Dim n As Integer, sp As Variant For n = ActiveSheet.Shapes.Count To 1 Step -1 Set sp = ActiveSheet.Shapes(n) If Not Intersect(Range(sp.TopLeftCell, sp.BottomRightCell), myRng) Is Nothing  (ここで実行時エラー1004になります。) Then sp.Delete End If Next Set myRng = Nothing End Sub

  • 記述

    下記コードでRows("gyou:gyou").Select が正しくありません。Rows("4:4").Select の意味にさせるにはどう記述すればよいか。お教え願います。 Sub Macro1() ' Dim gyou As Integer gyou = 4 ' Rows("4:4").Select Rows("gyou:gyou").Select Selection.Insert Shift:=xlDown End Sub

  • VBAでの処理分岐方法を教えてほしいです

    VBAの分岐処理で悩んでおります。 誰かお助けお願いします。 A列に昇順で番号があります。 1 2 4 4 5 6 9 欠番や重複した数値があります。 やりたいことは欠番箇所に行を挿入し、連番にしたいです。 この例で言うと、3行目に1行を挿入し番号を3と入れる、6行目に2行挿入し7,8と連番にする。 連番になった後に、重複した数値に色を付けます。 以下私が作成したコードです。callで呼び出す予定です。 Sub 欠番判定数式() Dim i As Integer For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row Cells(i, 3) = "=if(iserror(if(A" & i & "-A" & i - 1 & ">1,""○"","" "")),"""",if(A" & i & "-A" & i - 1 & ">1,""○"","" ""))" Next End Sub Sub 行挿入() Dim c As Range, Target As Range For Each c In Range("C2:C" & Cells(Rows.Count, 1).End(xlUp).Row) If c = "○" Then If Target Is Nothing Then ''(1) Set Target = c Else Set Target = Union(Target, c) ''(2) End If End If Next c If Not Target Is Nothing Then Target.Select Selection.EntireRow.Insert , copyorigin:=xlFormatFromLeftOrAbove End Sub Sub 空白連番入力() Dim i As Integer For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, 1) = "" Then Cells(i, 1) = (Cells(i, 1).Offset(1, 0).Value) - 1 End If Next End Sub Sub 番号重複確認() Dim i As Integer For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row If Application.WorksheetFunction.CountIf(Range("$A$2:$A$" & Cells(Rows.Count, 1).End(xlUp).Row), Range("A" & i)) <> 1 Then Cells(i, 1).Interior.ColorIndex = 3 End If Next End Sub このコードを順に全て実行した時、1回目の処理で3行目と5行目に行挿入、そして番号が3と7と入力され連番に色が設定されます。 再度「欠番判定数式」を行い、次は8行目に行挿入し8と連番を入力させ処理を繰り返しさせたいです。 欠番は例として最高2個にしてますが、これから2個以上の可能性もあります。 一度全処理終了後、再度最初の処理(欠番判定数式)に戻り、欠番がある場合は行挿入させという処理を行わせ、欠番がない場合は次の処理に進めるという分岐方法を教えてほしいです。 よろしくお願いいたします

  • マクロが実行しない

     二行三列を一枡として月の勤務割表を作成しています。マクロで同じ事を しているのにMacro1の方が実行しません。お教え願えませんでしょうか。 (尚、図形を枠線上にコピペしています。) Sub Macro1()実行しません。 Dim i As Integer Dim j As Integer For i = 10 To 43 Step 2 For j = 10 To 103 Step 3 Select Case Cells(i, j).Value Case 1: ActiveSheet.Shapes("四角形1").Select Selection.Copy Cells(i + 1, j + 1).Select ActiveSheet.Paste End Select Next Next End Sub Sub Macro2()実行します。 ActiveSheet.Shapes.Range(Array("四角形1")).Select Selection.Copy Range("J11:K11").Select ActiveSheet.Paste End Sub

  • VBA エクセル 実行時エラー13:型が一致しません

    またまたお世話になります。 下記のマクロを走らせると、タイトルのようなエラーメッセージが出てしまいます。 Sub rows_hdn() Dim n As Integer Sheets("ABC").Select n = 3 Do Until Cells(n, 2).Value = "" n = n + 1 Loop Sheets("EFG").Select If n <> 3 Then Rows("3:n-1").Select Selection.EntireRow.Hidden = True End If End Sub シートABCに入力がされているライン数だけ、シートEFGの3行目から隠したいのですが、どのようにすればよろしいのでしょうか? よろしくお願いいたします。

  • VBA超初心者です

    皆さんのお知恵を拝借させてください。 Sub Macro1() ' ' Macro1 Macro ' マクロ記録日 : 2007/12/1 ユーザー名 : 101 ' Dim pearend As Integer Dim code As Integer Dim codeend As Integer Dim sheet_name As String Dim dayend As Date Sheets("商品名").Select Range("A4").Select Selection.End(xlDown).Select pearend = Selection.Row() For l = 4 To pearend Step 2 For r = 2 To 3 Cells(l, r).Select code = Cells(l, r).Value Select Case code Case 1000 To 1999 sheet_name = "1000" Case 2000 To 2999 sheet_name = "2000" Case 3000 To 3999 ssheet_name = "3000" Case 4000 To 4999 sheet_name = "4000" Case 5000 To 5999 sheet_name = "5000" End Select Sheets(sheet_name).Select Range("B4").Select Selection.End(xlToRight).Select codeend = Selection.Column() Range("A5").Select Selection.End(xlDown).Select dayend = Selection.Row() For i = 2 To codeend If code = Cells(4, i).Value Then Range(Cells(dayend, i), Cells(5, i)).Select Selection.Copy Sheets("商品名").Select Range("K3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If Next Next Next End Sub というマクロをつくってみたのですが、何順目かあたりから For r = 2 To 3 のrがなぜか4になっています。正直知識がないのでさっぱりわかりません。どこに問題があるか詳しい方教えてください。

  • 【VBA】ExcelマクロでCSVファイルに保存したデータが""で囲まれてしまう

    添付図のような、Excel2003で作成した表内のデータを CSVで保存するマクロを作成したのですが、 図のように、CSVファイルに「""」で値が囲まれた状態で、 保存されてしまいます。 下記にマクロを記載しますので、 どうすれば文字列が「""」で囲まれずに、 カンマ区切りだけのデータで出力されるのか、 ご存知の方おられましたら、ご教示お願い致します。 Sub csv保存() Dim フォルダ名 As String Dim パス名 As String Dim ファイル名 As String Dim データ As Variant Dim 行数 As Long, 列数 As Integer Dim i As Integer, j As Long, k As Long ファイル名 = "test.csv" フォルダ名 = "csv" パス名 = ActiveWorkbook.Path & "\" & _ フォルダ名 'csvフォルダが存在しなければ作成する If Dir(パス名, vbDirectory) = "" Then MkDir パス名 End If ChDir パス名 Open ファイル名 For Output As #1 For i = 1 To Worksheets.Count Worksheets(i).Activate Worksheets(i).Cells(1, 1).Select ActiveCell.CurrentRegion.Select 行数 = Selection.Rows.Count 列数 = Selection.Columns.Count For j = 1 To 行数 For k = 1 To 列数 - 1 データ = Selection.Cells(j, k) _ .Value Write #1, データ; Next k Write #1, Selection.Cells(j, 列数) _ .Value Next j Next i Close #1 End Sub

  • エクセル2003(VBA)で違うフォームのチェックボックス配列を繰り返し処理したい

    エクセル2003(VBA)で違うフォームのチェックボックス配列を 元に順番に繰り返し処理したいのですが、うまくいきません。 どうかお知恵をお貸し下さい。 よろしくお願いします。 ■<ユーザーフォーム1>(本体フォーム) Private Sub CommandButton1_Click() UserForm2.Show Dim n As Integer Dim ender As Integer ender = 1 i = 1 For n = 1 To 20 If i > 4 Then i = 1 '4を超えたら1に戻る If cb(i).Value = False Then 'チェックがなかったら飛ばす i = i + 1 '次の配列へ n = n - 1 'ループ回数をカウントしないように1引く Else Worksheets("sheet1").Cells(ender, 5).Select Worksheets("sheet1").Cells(ender, 5) = "■" & cb(i).Caption & " = " & cb(i).Value ender = ender + 1 i = i + 1 End If Next n End Sub ■<ユーザーフォーム2>(チェックボックスフォーム) Private Sub CommandButton1_Click() Const cb_num = 4 'チェックボックスを4個に設定 Dim cb(cb_num) As Control Dim ctrl As Control Dim i As Integer i = 0 For Each ctrl In Me.Controls 'コントロールの数だけループする If TypeName(ctrl) = "CheckBox" Then 'タイプがチェックボックスなら i = i + 1 If i > cb_num Then Exit For 'チェックボックスの数を超えたコントロールは無視 Set cb(i) = ctrl 'コントロールを配列に代入 End If Next ctrl End Sub