セルにデータが入っていないのを見つけるには？
- ユーザフォームにあるコマンドボタンを押すと、Sheet1のセル"Ｄ４"から横方向→にセルの中にデータが入っていない所までループし、データが入っていないセルがあったら"END"が入力され終了します。
- しかし、このコードは正しく動作しません。何が問題なのか教えてください。
- 使用する変数の初期値が間違っている可能性があります。または、セルの位置が正しく指定されていないかもしれません。
- ベストアンサー
セルにデータが入っていないのを見つけるには？
ユーザフォームにあるコマンドボタンを押すと、Sheet1のセル"Ｄ４"から横方向→にセルの中にデータが入っていない所までループし、データが入っていないセルがあったら"END"が入力され終了したいのですが。。 Private Sub CommandButton5_Click() Dim u As Integer u = 4 Do Until Worksheets("Sheet1").Cells(7, u).Value = "" If Worksheets("Sheet1").Cells(7, u).Value = "" Then Worksheets("Sheet1").Cells(7, u).Value = "END" End If u = u + 1 Loop End Sub このコードでは無反応でした。なにがいけないのかご指摘お願いいたします。 ExcelVBAです。
- jam118
- お礼率54% (6/11)
- Visual Basic
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
おはようございます >Do Until Worksheets("Sheet1").Cells(7, u).Value = "" で空セルを見つけると LOOP以降に飛びますので、”END”は入力されないでしょう。 u = 4 Do Until Worksheets("Sheet1").Cells(7, u).Value = "" u = u + 1 Loop Worksheets("Sheet1").Cells(7, u).Value = "END" になると思います。 恐らくCurrentRegionは使いたくない状況と思います。 または、Dｏ自体を使わないで、 Worksheets("Sheet1").Cells(7, 256).End(xlToLeft).Select Cells(7, ActiveCell.Column + 1) = "END" でもいいかもしれません。
関連するQ&A
- エクセル・見積表の抽出印刷方法？その３
先日（No．130709とNo．130958）、エクセルで作成した見積表の数量を入力した行のみを印刷したいとお聞きした者です。その際は、多くの方に回答を頂き、誠にありがとうございました。おかげさまで完成間近ですが、もう1つ問題が出てきてしまいました。宜しくお願いします。 商品によっては、行を追加し手で入力しなくてはならないものがあるので、あらかじめ空白行（金額列には０が入っています）を設けておきたいのですが、そうすると抽出した際、空白行も一緒に抽出されてしまいます。空白行がある場合は、下記の構文のやり方では無理なのでしょうか？空白行も非表示にしたいのです。 Private Sub CommandButton1_Click() Dim i As Integer i=2 Do Until i=-1 If Worksheets("Sheet1").Cells(i,1).Value=""Then i=-1 Else If Worksheets("Sheet1").Cells(i,6).Text=0Or_ Worksheets("Sheet1").Cells(i,6).Text=""Then Worksheets("Sheet1").Rows(i).Select Selection.EntireRow.Hidden=True End If i=i+1 End If Loop End Sub Private Sub CommandButton2_Click() Worksheets("Sheet1").Cells.Select Selection.Rows.Hidden=False End Sub 以上です。 宜しくお願いします。
- ベストアンサー
- オフィス系ソフト
- Do～Loopステートメント
Do～Loopステートメントで使わな方が良いステートメントとは？ Do～Loopステートメントで「古いから使わない方がよい」、と言われたことがあるのですが どれの事だか忘れてしまいました。 Sub test() セルのA1～A10に1～10を入力する i = 1 Do While i < 11 Worksheets("Sheet1").Cells(i, 1).Value = i i = i + 1 Loop End Sub これは一般的だから使ってもよいと思います。 Sub test() セルのA1～A10に1～10を入力する i = 1 Do Until i = 11 Worksheets("Sheet1").Cells(i, 1).Value = i i = i + 1 Loop End Sub これもよく見かけます。 Do While,Do Until以外にもloopステートメントってありますか？ あと使わない方が良いステートメント、私の勘違いでなければ教えてください。
- ベストアンサー
- オフィス系ソフト
- VBAにてリストボックスに表示された文字をエクセルのセルにコピペするには
先日、ここで教えてもらった以下の内容で、幾つかのテキストボックスに表示された内容のうち、電話番号をエクセルのセルに転記する方法が、上手くいきません。”検索"名のシート上で実行します。 過去のログを参考にしましたが、解決できませんでした。 またお世話になりますが、だれか教えてください。 Private Sub CommandButton1_Click() Dim Namae As String Dim MeNamae As UserForm Dim ken As String Namae = TextBox1.Text Set MeNamae = UserForm1 Call 検索(Namae, MeNamae) End Sub Public Sub 検索(ByVal Namae As String, ByRef MeNamae As UserForm) Dim Nagasa As Integer Dim i As Long Dim MaxRows As Long Dim kensaku As Worksheet Dim KensakuChar As String Dim ListNamae As String Dim ListChar As String Dim KBanme As Integer Dim LBanme As Integer Set kensaku = Worksheets("顧客データ") MaxRows = kensaku.UsedRange.Rows.Count Nagasa = Len(Namae) MeNamae.ListBox1.Clear For i = 3 To MaxRows ListNamae = kensaku.Cells(i, 3) KBanme = 0 LBanme = 0 Do Do While Nagasa >= KBanme KBanme = KBanme + 1 KensakuChar = Mid(Namae, KBanme, 1) If KensakuChar <> " " Then Exit Do End If Loop Do While Nagasa >= LBanme LBanme = LBanme + 1 ListChar = Mid(ListNamae, LBanme, 1) If ListChar <> " " Then Exit Do End If Loop If KensakuChar = ListChar Then If Nagasa = KBanme Then With MeNamae .ListBox1.AddItem (ListNamae) .ListBox1.List(.ListBox1.ListCount - 1, 1) = i End With End If Else Exit Do End If Loop Until Nagasa <= KBanme Next End Sub Private Sub ListBox1_Click() Dim r As Long With ListBox1 If .ListIndex > -1 Then r = .List(.ListIndex, 1) '選択した名前の行 TextBox6.Value = Worksheets("顧客データ").Cells(r, 3) 'カタカナ名 TextBox2.Value = Worksheets("顧客データ").Cells(r, 5) '漢字名 TextBox3.Value = Worksheets("顧客データ").Cells(r, 7) '住所 TextBox4.Value = Worksheets("顧客データ").Cells(r, 1) '電話番号 TextBox5.Value = Worksheets("顧客データ").Cells(r, 2) '顧客番号 End If End With End Sub Private Sub CommandButton3_Click() 'クリックすると Worksheets("検索").Cells(, 2) ’このシートの(G2)に上記の電話番号が入力される End Sub
- ベストアンサー
- Visual Basic
- ユーザーフォームのデータ
ユーザーファームを２つ作成しました。 そのユーザーフォームのデータを表の最終行に追加をしたいのです。 Range("A65536").End(xlUp).Offset(1,0).select を使おうと思っていますが、うまくいきません。 どなたか教えてください。 ＜ユーザーフォーム１＞ Private Sub CommandButton1_Click() Sheet2.Range("H7") = TextBox1 Sheet2.Range("I7") = TextBox2 Sheet2.Range("J7") = TextBox3 Sheet2.Range("K7") = TextBox4 Sheet2.Range("L7") = TextBox5 Sheet2.Range("P7") = TextBox6 If CheckBox1.Value = True Then Worksheets(2).Range("M7") = "0:30" Else Worksheets(2).Range("M7") = "0:00" End If If CheckBox2.Value = True Then Worksheets(2).Range("R7") = "1000" Else Worksheets(2).Range("R7") = "0" End If If CheckBox3.Value = True Then Worksheets(2).Range("S7") = "3000" Else Worksheets(2).Range("S7") = "0" End If If CheckBox4.Value = True Then Worksheets(2).Range("T7") = "1500" Else Worksheets(2).Range("T7") = "0" End If Unload Me End Sub ＜ユーザーフォーム２＞ Private Sub CommandButton1_Click() Sheet2.Range("V7") = TextBox1 Sheet2.Range("W7") = TextBox2 Sheet2.Range("X7") = TextBox3 Unload Me End Sub
- ベストアンサー
- オフィス系ソフト
- DTPickerで入力したらの検索が出来なくなりました。
お世話になります。 質問ですが 以下のVBAコードがあります。Sheet3のCells(2, 6)に記入した日付によってSheet1の検索を一部行うのですが、Cells(2, 6)への入力をDTPickerを使って行うようにしたら該当する日付がありませんのエラーが帰ってきます。たぶん書式が違うせいかなと思うのですがどうすればいいのでしょうか？ どなたか分かる方いらっしゃいますか？よろしくお願いします。 Private Sub CommandButton1_Click() Dim trgA As Variant, trgB As Variant With Worksheets("Sheet3") If IsEmpty(.Cells(2, 7)) Then MsgBox "個数が空です。", vbCritical: Exit Sub '日付 trgA = Application.Match(.Cells(2, 6).Value2, Worksheets("Sheet1").Range("A:A"), 0) If IsError(trgA) Then MsgBox "該当する日付がありません。", vbCritical: Exit Sub '製品名 trgB = Application.Match(.Cells(2, 4).Value, Worksheets("Sheet1").Range("2:2"), 0) If IsError(trgB) Then MsgBox "該当する製品名がありません。", vbCritical: Exit Sub If Worksheets("Sheet1").Cells(trgA, trgB + 1).Value = "" Then Worksheets("Sheet1").Cells(trgA, trgB + 1).Value = .Cells(2, 7).Value Else If MsgBox("上書きしますか", vbQuestion + vbOKCancel) = vbOK Then Worksheets("Sheet1").Cells(trgA, trgB + 1).Value = .Cells(2, 7).Value End If End If End With End Sub
- 締切済み
- オフィス系ソフト
- 複数選択可能なリストボックス
Excel VBAの質問をさせてください。 シート(sheet1)のA列、セルA1から以下のデータがあるとします。 みかん りんご バナナ 苺 梨 バナナ バナナ みかん フォームのリストボックスで"みかん"と"バナナ"を選択した際、シート(sheet2)のセルA1にコピーしていきたいのですが機能しません。 単品、"みかん"だけを選択しても何もコピーされません。 どこがいけないでしょうか?? Private Sub UserForm_Initialize() With ListBox1 .AddItem "みかん" .AddItem "りんご" .AddItem "バナナ" .AddItem "苺" .AddItem "梨" .MultiSelect = fmMultiSelectMulti End With End Sub Private Sub CommandButton1_Click() Dim i As Long For i = 1 To 8 If Worksheets("Sheet1").Cells(i, "A").Value = Me.ListBox1.Value Then Worksheets("Sheet1").Cells(i, "A").Copy Worksheets("Sheet2").Cells(i, "A") End If End Sub
- ベストアンサー
- Visual Basic
- エクセルで四者択一の問題を作りたい。・フォーム画面のボタンをクリック、解答、採点画面を出したい。
一応、フォーム画面で、ボタンをクリックするとデータシートから 持ってきて、それを問題がなくなるまで繰り返したいのですが、うまく いきません。 Private Sub cmd次_click() Dim n As Integer For n = 3 To Cells(Rows.Count, 1).End(xlUp).Row txt設問.Value = Worksheets("データ").Cells(n, 1).Value txt問1.Value = Worksheets("データ").Cells(n, 2).Value txt問2.Value = Worksheets("データ").Cells(n, 3).Value txt問3.Value = Worksheets("データ").Cells(n, 4).Value txt問4.Value = Worksheets("データ").Cells(n, 5).Value n = n + 1 Next n End Sub Private Sub cmd判定_click() If op3.Value = True Then txt正解.Value = "○" Else txt正解.Value = "×" End If End Sub Private Sub cmd消去_Click() txt設問.Value = "" txt問1.Value = "" txt問2.Value = "" txt問3.Value = "" txt問4.Value = "" txt正解.Value = "" op1.Value = "" op2.Value = "" op3.Value = "" op4.Value = "" End Sub よろしければ、教えていただけないでしょうか？
- ベストアンサー
- その他MS Office製品
- VBAで空欄にデータに表示
エクセルVBAのIFを使って、シートaのA列に値があって、B列が空欄の場合のみ、空欄のセルにシートbの値を表示させたいです。 上手くできませんでしたので、教えてください。 Sub Do文2() Dim i As Integer i = 1 If Worksheets("a").Cells(i, 2) = "" Then Do While Worksheets("a").Cells(i, 1) <> "" Worksheets("a").Cells(i, 2) = Worksheets("b").Cells(1, 1) i = i + 1 Loop End If End Sub
- ベストアンサー
- Windows Vista
- 選択範囲の空白セルに0を入れるマクロ
Private Sub CommandButton1_Click() If Cells("選択範囲").SpecialCells(xlcellTypeblank).Select Then Range("選択範囲").Value = 0 End If End Sub このマクロを作成したのですが、動きません。 どこが、おかしいのでしょうか？
- ベストアンサー
- オフィス系ソフト
- 実行時エラー1004空白セルを上に詰める
よろしくお願いします いろいろ試しましたが解決できませんでした。 Private Sub CommandButton1_Click() With Worksheets("Sheet1") For r = 2 To .Cells(Rows.Count, "C").End(xlUp).Row If .Cells(r, "C").Value = 提出先.Value Then Me.提出先.Value = "" .Cells(r, "C").Value = "" Else End If Next r .Range("J3").Value = "" ’下記の構文でエラーが出ます ’実行時エラー1004 ’アプリケーション定義またはオブジェクト定義のエラーです .Range(Range("C2"), Cells.SpecialCells(xlCellTypeLastCell)).SpecialCells (xlCellTypeBlanks).Delete Shift:=xlUp End With End Sub
- ベストアンサー
- Visual Basic
お礼
さっそくのお返事ありがとうございます。 無事できました！ありがとうございました！