• ベストアンサー

エクセルVBAで

登録ボタンを作りたいのですが うまくいきません。 応答無しになってしまいます。 仕事でコードを入力して、住所やその他の関連事項を 登録して、検索し、封筒に宛名印刷し、登録内容の修正をしたいと思っています。 登録ボタンは下記のようなものを作りました。 Private Sub CommandButton1_Click() Dim bk As Workbook Dim sh1 As Worksheet Dim sh2 As Worksheet Dim cnt1 As Long Set bk = ThisWorkbook Set sh1 = bk.Worksheets("現場登録検索") Set sh2 = bk.Worksheets("一覧") cnt1 = 6 Do While sh2.Cells(cnt1, 2).Value <> "" cnt = cnt1 + 1 Loop '得意先CD sh2.Cells(cnt1, 2).Value = sh1.Cells(2, 3).Value '現場CD sh2.Cells(cnt1, 3).Value = sh1.Cells(3, 3).Value '送り方 sh2.Cells(cnt1, 22).Value = sh1.Cells(4, 3).Value '封筒 sh2.Cells(cnt1, 23).Value = sh1.Cells(5, 3).Value MsgBox "登録できました。" End Sub 何が悪いのでしょうか? よろしくお願い致します。

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

  • ベストアンサー
  • papayuka
  • ベストアンサー率45% (1388/3066)
回答No.1

cnt = cnt1 + 1 ではループが終了しませんね。 cnt1 = cnt1 + 1 B列最終行+1ならループを使わずに下記でも良いと思います。 cnt1 = sh2.Range("B65536").End(xlUp).Row + 1

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

その他の回答 (1)

回答No.2

無限ループになってしまうのは、No.1さんの回答の通りです。このような場合、コードの一番先頭に Option Explicit を入れるといいです。 もしくは、VBEの画面で、「ツール」ー「オプション」で表示される画面の「編集」タブの「変数の宣言を強制する」にチェックを入れた方がいいと思います。 こうすると変数の宣言を強制されますので、cnt1を宣言しながら、コードの中でcntを記述してしまうようなミスを排除できます。

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

関連するQ&A

  • VBAで修正ボタンを作成

    先ほどは登録ボタンを作成したのでが、 修正ボタンもあれば便利だと思い作りたいのですが 一向にできません。 一覧表より、番号を検索して一致するセルの場所に 上書き?保存をするようにしたいのですが どのようにすればよいでしょうか? 先ほどから新たに訂正を加えたのですが、 やはりダメでした。 Private Sub CommandButton2_Click() '修正ボタン Dim bk As Workbook Dim sh1 As Worksheet Dim sh2 As Worksheet Dim cnt1 As Long Set bk = ThisWorkbook Set sh1 = bk.Worksheets("現場登録検索") Set sh2 = bk.Worksheets("一覧") cnt1 = 6 'マッチ Range("F2").Select n = ActiveCell.FormulaR1C1 = "=MATCH(RC[-1],一覧!C[-5],0)" cnt1 = n '送り方 sh2.Cells(n, 22).Value = sh1.Cells(4, 3).Value '封筒 sh2.Cells(n, 23).Value = sh1.Cells(5, 3).Value MsgBox "修正できました。" End Sub よろしくお願い致します。

  • エクセル2019 VBAについて

    エクセル2019でVBAを使いコピーペーストの勉強中です、次の箇所(Dim i As integr)で、ユーザー定義型は定義されていませんと指摘されて止まってしまします、Sheet("データ")には3行のデータは入っています、VBA初心者のため、この後が、なかなか前に進めません、どうかよろしくおねがいします。 ********************************** Sub 練習() Dim s1 As Worksheet: Set s1 = Worksheets("請求書") Dim s2 As Worksheet: Set s2 = Worksheets("データ") Dim r1 As Integer: r1 = 18 Dim r2 As Integer: r2 = 2 { Dim i As integr } For i = 0 To 2 s1.Range(s1.Cells(r1 + i, 1), s1.Cells(r1 + i, 3)).Value = s2.Range(s2.Cells(r2 + i, 2), s2.Cells(r2 + i, 4)).Value s1.Cells(r1 + i, 4).Value = s1.sells(r1 + i, 2).Value * s1.Cells(r1 + i, 3).Value Next End Sub ***************************************

  • VBA なんですが

    VBA なんですが すべてのワークシートを順番に選択して 指定した範囲をコピーし『まとめ』と言う別のシートに貼り付けたいのですが どうしたらいいのかわかりません。 それらしいのは考えたのですが Set sh = Worksheets(sh.Name)でエラーになります。 頭がいいかた教えてください。   Dim sh3 As Worksheet Dim sh As Worksheet Dim en As Long Set sh3 = Worksheets("まとめ") For Each sh In ActiveWorkbook.Worksheets If sh.Name <> "まとめ" Then en = sh.UsedRange.Rows.Count Set sh = Worksheets(sh.Name) sh.Range(Cells(2, 1), Cells(en, 10)).Copy

  • VBA 初心者

    sheet1から、sheet2データを検索して抽出する練習をしているのですがerror"1104"が表示されます、なぜなのか分からないので投稿しました、よろしくお願いします。 sub test() dim sh1 as worksheets dim sh2 as worksheets dim  i  as  integer set sh1 = thisworkbook.worksheets("sheet1!") set sh2 = thisworkbook.worksheets("sheet2!") b = userform1.textbox1 for i = 1 to 10 sh1 .cells(i,2) = b b = b+1 x = sh1.cells(1,2) sh1.cells(i,3).value = worksheetfunction.vlookup(x,sh2.range("a1:d500"),2,false) next i end sub

  • エクセルVBAで実行時エラー 91 が出ます

    エクセル2000です 各部署の棚卸を纏める為のVBAを作成しているのですが、実行時にエラーになってしまいます エラーメッセージは 「実行時エラー 91   オブジェクト変数またはWithブロック変数が設定されていません」 です ご教授お願いいたします Sub 棚卸() Dim sh1 As Worksheet Dim sh2 As Worksheet Set sh1 = Worksheets("在庫集計票") Set sh2 = Worksheets("棚卸表") x = sh2.Range("A65536").End(xlUp).Row Z = sh1.Range("d2").Value ’部署番号 sh1.Range(Cells(5, Z), Cells(3000, Z)).ClearContents For i = 2 To x y = sh1.Range("A2:A" & Range("A2").End(xlDown).Row). _ Find(sh2.Cells(i, "a")).Row ’ここでエラーが発生します sh1.Cells(y, Z) = sh2.Cells(i, "c") Next i End Sub

  • EXCELのVBAについて教えてください。

    演習1というシートの(1,1)のセルの値と(1,2)のセルの値を入れ替えるプログラムを作成したいので すがエラーが出て出来ません。コードは下記の様に書きました。 Sub 演習1() Dim sheetobj As Worksheet Dim a As Integer Set sheetobj = ThisWorkbook.Worksheets("演習1") With sheetobj a = .Cells(1, 1) .Cells(1, 1) = .Cells(1, 2) .Cells(1, 2) = a End With End Sub プログラミング自体が本を読んでも分かりません。 宜しければ小学生に教えるように文を訳してくれませんか?

  • ExcelのVBAについて(勉強中のです。)

    ExcelのVBAについて(勉強中のです。) ここからコード3以降に入力したコードを抜き出してデータ表を作成しそれを保存するコードを作成したいです。例えばCSV形式にするとか? データ表は1日分の表示で、保存して週間や月間または統計データまでを視野にいれています。今回は保存する所です。。 利用しやすい状態と保存形式で、よろしくお願いします。データは生活記録みたいなものです。何したどうしたどうなった? ※大分分岐する予定で、作成中であり、今回はコードの整理は不要です。 '///Sheet1/// Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim time7 As Range For Each time7 In Target If time7.Column = 1 Then time7.Offset(0, 4).Value = Format(Now, "Short Time") & vbCrLf & _ Format(Now, "yyyy/mm/dd hh:nn:ss AM/PM") End If Application.EnableEvents = False Application.EnableEvents = True Next time7 '(1)シートを変数にセット Dim ws1 As Worksheet Dim ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") '(2)シートを指定してデータを転記 ws2.Range("A3:H3").Value = ws1.Range("A3:H3 ").Value End Sub Private Sub Worksheet_Activate() ' ' 新規行挿入 ' ' Worksheets("Sheet2").Range("3:3").Insert Sheets("Sheet1").Range("H3").Select ActiveCell.FormulaR1C1 = "5" Sheets("Sheet1").Range("E3").Select Selection.ClearContents Dim str_Left As String 'セルE4に文字列、セルH4に数字を予め入れておくこと。 str_Left = Left(Cells(4, 5), Cells(4, 8)) MsgBox str_Left & vbCrLf & " " & "OKボタンを押してください!" Sheets("Sheet1").Range("A3").Select Dim se_r As String se_r = Application.InputBox("バーコードを入力してください") Select Case se_r Case "False" MsgBox "キャンセルされました" Case "" MsgBox "空欄が入力されました" Case Else Range("A3").Value = se_r End Select End Sub ' ///Sheet2/// Private Sub Worksheet_Activate() Dim Emp(1 To 300) As String Dim msg As String Dim i, i2, Cnt As Integer Dim N_In As Variant For i = 3 To 3 If IsEmpty(Cells(i, 1).Value) = False Then 'ここで空欄判定 Worksheets("Sheet1").Range("3:3").Insert '対象セルアドレスを改行処理 End If Next i '(1)シートを変数にセット Dim ws1 As Worksheet Dim ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") ws1.Activate End Sub

  • エクセルVBAのオートフィルタについて

    いつもお世話になります。 エクセル2007でVBAでオートフィルタを操作したいのですが、 一部うまくいきません。 以下の様なコードを書いて 日付で絞り込みたいのですが、 何も抽出されません。 リストを見てみると、変数はちゃんと入っており OK ボタンを押すとその日付で抽出されます。 何故VBAでの操作では抽出されないのでしょうか。 ご存じの方がおられましたら、よろしくお願いします。 Sub test() Dim mydate As Variant Dim rng3 As Range Dim fmt As Variant Dim objList3 As ListObject Dim wb1 As Workbook Dim wb2 As Workbook Dim wb4 As Workbook Dim sh1 As Worksheet Dim sh2 As Worksheet Dim sh3 As Worksheet Dim sh4 As Worksheet Dim sh7 As Worksheet '----------------------------------------------------------------------- Set wb1 = Workbooks("301.xlsm") Set wb2 = Workbooks("1.xls") Set wb4 = Workbooks("2.xls") Set sh1 = wb1.Worksheets("@") Set sh2 = wb1.Worksheets("@@") Set sh3 = wb2.Worksheets("@@@") Set sh4 = wb2.Worksheets("@@@@") Set sh7 = wb4.Worksheets("@@@@@") '---------------------------------------------------------- sh2.Range("A1:z63").ClearContents With sh7 Set objList3 = .ListObjects("リスト1") fmt = .Range("A2").NumberFormatLocal mydate = Format(mydate, fmt) objList3.Range.AutoFilter Field:=7, Criteria1:=mydate objList3.Range.AutoFilter Field:=5, Criteria1:="test" Set rng3 = objList3.Range.SpecialCells(xlCellTypeVisible) rng3.Copy sh2.Range("A2") objList3.Range.AutoFilter Field:=5 objList3.Range.AutoFilter Field:=5, Criteria1:=">=190" Set rng3 = objList3.Range.SpecialCells(xlCellTypeVisible) rng3.Copy sh2.Range("A20") objList3.Range.AutoFilter Field:=5 objList3.Range.AutoFilter Field:=7 End With Application.CutCopyMode = False Set rng3 = Nothing Set fmt = Nothing Set objList3 = Nothing Set wb1 = Nothing Set wb2 = Nothing Set wb4 = Nothing Set sh1 = Nothing Set sh2 = Nothing Set sh3 = Nothing Set sh4 = Nothing Set sh7 = Nothing End Sub (一部省略しています)

  • エクセルVBA selectionの書き方をヘルプ!

    ここで教えてもらったVBAを書き直して以下のように作りました。 Sub TEST() Dim sh1 As Worksheet Dim sh2 As Worksheet Set sh1 = Worksheets("Sheet1") Set sh2 = Worksheets("Sheet2") d = 5 For i = 1 To d Set x = sh2.Range("E7:F11").Find(What:=sh1.Cells(i, "C"), After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) If Not x Is Nothing Then sh1.Cells(i, "D") = x.Offset(0, 1) Next i End Sub ところが「RangeクラスのFindプロパティが取得できません」とエラーになってしまいます。Range("E7:F11")をCellsにすればエラーにはならないのですが、検索範囲を指定したいのです。 sh2.Select Range("E7:F11").Select を入れ、Range("E7:F11")をSelectionにすれば動くのもわかりました。でもSelectせずにやりたいのです。 わがまま言いますが、お教えくださいませ。 お願いします。

  • どなたかマクロ修正お願いします。

    自分なりに 作成してみましたがどうもうまくいきません。 Sub 変換() Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet, Dim r As Range Set Sh1 = Worksheets("1") Set Sh2 = Worksheets("2") Set Sh3 = Worksheets("3") Sh3.Select Set c = Cells.Find(What:="9876543", LookAt:=xlWhole) c.Offset(, 1).Activate ActiveCell.Replace What:="中田", Replacement:="中田英寿" End Sub このように作成しましたがうまくいきません。恐らくsheet3のデータはsheet1から( =1!A100 )といったように値を他のsheetから持ってきてるからではないんでしょうか?

このQ&Aのポイント
  • EW-M571のスキャンができなくなりました。Epson Scan2を何度もアンインストールして再インストールしても、スキャナーの設定窓が表示されます。
  • デバイスマネージャーによると、EW-M571は正常に動作していると表示されます。しかし、スキャンができない状態が続いています。
  • EW-M571のスキャナーの設定窓が表示される原因としては、接続ケーブルの不良や設定の不備が考えられます。再度接続ケーブルの確認を行い、正しい設定を行うことをおすすめします。
回答を見る

専門家に質問してみよう