• 締切済み

EXCEL2002 VBAのループ処理について

セルB1~B24に入力した数字を i とすると、 コマンドボタンを押したときに、セルB1~B24にの全てに値が入力されていて、 セル( F & i )が空白であれば、そこにセルA1の値を入れるようなマクロを作成しています。 セル( F & i )への入力は、セルB1~B24の全部に数値が入力されており、セル( F & i )が空白があるときのみ処理が実行されるように。どちらかが満たされない場合には、メッセージボックスを表示し、処理しないようにしたいのですが、どうしても途中まで入力されてしまいます。 以下のようなコードですが、何か良い方法はないでしょうか? Private Sub CommandButton1_Click() 'ロール確認 Dim 入力 As String, パレット As String Dim i As Long, t As Long For i = 1 To 24 入力 = Range("B" & i) パレット = Range("F" & i) If 入力 = "" Then MsgBox "aaa" Exit For End If 'パレットNo.転記 If パレット <> "" Then MsgBox "bbb" Exit For ElseIf パレット = "" Then Range("F" & 入力).Value = Range("A1").Value End If Next i End Sub

みんなの回答

  • hige_082
  • ベストアンサー率50% (379/747)
回答No.3

条件が曖昧です 前半の説明では B1~B24すべてに必ず値が入っている 入っていなければ、処理をメッセージ表示後中止 入っていれば、F1~F24の値が空白のもののみ、A1の値を代入する しかし、後半の説明では B1~B24すべてに必ず値が入っている 入っていなければ、処理をメッセージ表示後中止 はいって入れば、次の条件 F1~F24すべてが必ず空白である 空白でなければ、処理をメッセージ表示後中止 空白でならば、F1~F24すべてに値を代入 どちらなのか、判断に苦しむ所です しかし >どうしても途中まで入力されてしまいます。 と、最後にあるので、後半の条件であろうと解釈し コードを修正してみました Private Sub CommandButton1_Click() 'ロール確認 Dim 入力 As String, パレット As String Dim i As Long, t As Long '---B1~B24すべてに値が入っていることの確認 For i = 1 To 24 入力 = Range("B" & i) If 入力 = "" Then MsgBox "aaa" Exit Sub End If Next i '---F1~F24すべてが空白であることの確認 For i = 1 To 24 パレット = Range("F" & i) 'パレットNo.転記 If パレット <> "" Then MsgBox "bbb" Exit Sub End If Next '---F1~F24に値の入力 For i = 1 To 24 入力 = Range("B" & i)              '??? Range("F" & 入力).Value = Range("A1").Value  '??? 'Range("F" & i).Value = Range("A1").Value  'こっちでは '#2さんも指摘していますが、間違いでは? '間違いの場合は???の付いた2行を削除してください Next i End Sub 最初のうちは、一つ一つ処理をしていく方が確実で 分かりやすいと思います

  • merlionXX
  • ベストアンサー率48% (1930/4007)
回答No.2

B1:B24のすべてに数値がはいってなければ作動させないのであれば、最初に If Application.WorksheetFunction.Count(Range("B1:B24")) <> Range("B1:B24").Count Then  MsgBox "B1:B24のすべてに数値がはいるという前提を満たしません。"  Exit Sub End If を入れておけばいいと思います。 すると、If 入力 = "" Then のチェックはいらなくなりますね。 ただ、 i = 1 To 24としているのですから、セル( F & i )とはF1~F24ですよね? なのに、Range("F" & 入力).Value って、なんか変なようなきがしますがいいんでしょうか?

  • web2525
  • ベストアンサー率42% (1219/2850)
回答No.1

>セルB1~B24にの全てに値が入力されていて となっているのに範囲内の検索が終了する前にF&iセルに入力を行おうとしている部分が問題ですね。 一度B列の範囲内に""がないかどうかの確認を行いその後F列の指定セルに代入する形式に変える必要があります。

関連するQ&A

  • Excel2010 VBA 条件色付け

    Sub sample() Dim r As Range For Each r In Range("q6:q30") If myIsNumeric(r) Then r.Offset(0, 1).Value = "数字" Else r.Offset(0, 1).Value = "文字" End If Next End Sub Function myIsNumeric(Target As Range) Dim r As Range Dim buf, tmp Dim flg As Boolean Dim i As Integer buf = Target For i = 1 To Len(buf) tmp = Mid(buf, i, 1) If IsNumeric(tmp) Then flg = True Exit For End If Next myIsNumeric = flg End Function を数字が入ってたら塗りつぶさないで、 数字が入ってなかったら塗りつぶすように直したいです。 あああ→塗る あああ1-1→塗らない 住所→塗る 住所12→塗らない

  • エクセルVBAのイベントで質問です。

    ダブルクリックイベントで、G12:G31の範囲の文字列をB10:B27の範囲(最下行)に入れていくものを使っていますが、新たにH12:H31にある文字列もダブルクリックするとC10:C27の範囲(最下行)に入れていけるようにしたいと思います。 どのようにすればいいでしょうか。 ご存知の方いらっしゃればお教えいただけると助かります。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, _ Cancel As Boolean) Dim i As Long Dim flg As Boolean If Intersect(Target, Range("G12:G31")) Is Nothing Then Exit Sub If IsEmpty(Target.Value) Then Exit Sub With Worksheets("シートA") For i = 10 To 27 If .Range("B" & i).Value = "" Then .Range("B" & i).Value = Target.Value flg = True Exit For End If Next i If flg = False Then MsgBox .Name & " がいっぱいです。" End If End With Cancel = True End Sub

  • Excel VBAで検索(Win2000 Excel2000)

    現在、下記のようなコードを書いています。データテーブルの縦と横の検索値を探してその列数と行数を返したいのですが、下記の Sub検索1 と Sub検索2 を1つのSubで実行させるにはどうしたらよいのでしょうか?よろしくお願い致します。 ----------------------------------------- Sub 検索1() Worksheets("Data").Activate Dim x As Integer For x = 3 To 22 If Cells(2, x).Value >= 12 Then MsgBox x Exit Sub End If Next MsgBox "見つかりません" End Sub --------------------------------------------- Sub 検索2() Worksheets("Data").Activate Dim i As Integer For i = 4 To 42 If Cells(i, 2).Value = "A" Then MsgBox i Exit Sub End If Next MsgBox "見つかりません" End Sub

  • VBAのループ処理について

    VBA(Excel2000)にて、参考書等を見て下記のコードを作成しました。 「セルA1かA10において、同じ数値が続けて入力されたら、最後のセル(一番下のセル)をB列にコピーする。」 Sub ループ() Dim a As Long With Range("a1:a10") For a = 1 To .Count - 1 If .Cells(a).value <> .Cells(a + 1).value Then .Cells(a, 2).value = .Cells(a).value End If Next .Cells(.Count, 2).value = .Cells(.Count).value End With End Sub 上記の「For idx = 1 To .Count - 1」の意味が分かりません。 よろしくお願いします。

  • excel2000のVBAでループ内でループさせる方法

    excel2000でVBAを組んでいるのですが下記のような構文でループさせている中でループをさせたいのですがエラーメッセージ "Nextに対するForがありません"と出てしまいます。構文を以下に示しますので間違っている点をご指摘いただけたらと思います。 Dim h As Integer Dim I As Integer For h = 1 To 2 If h = 1 Then F_Name = "回送依頼(通常と翌月).xls" ElseIf h = 2 Then F_Name = "回送依頼(当日).xls" End If Windows(F_Name).Activate ActiveSheet.Unprotect For I = 1 To 2 'ループ内ループ If I = 1 Then S_Name = "通常" ElseIf I = 2 Then S_Name = "通常2" End If Sheets(S_Name).Activate Range("c7:i16").Select Selection.Copy Windows("請求書.xls").Activate Sheets("3").Select Selection.PasteSpecial Paste:=xlValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False Windows(F_Name).Activate ActiveSheet.Unprotect Sheets(S_Name).Activate Range("b7:b16").Select Selection.Copy Windows("請求書.xls").Activate Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False '値貼付 Next I ActiveWorkbook.Save ActiveWorkbook.Close Next h

  • VBAの処理を軽くしたい

    各行ごとに5回セルを参照した結果を吐き出すプログラムを作成しています。 200行前後の処理が必要なのですが、現在のコードではあまりにも処理が重くなっています。 とにかく処理を軽くしたいのですが、どのような方法が考えられるでしょうか? 初心者なのでコードも含めてご教示頂けたら幸いです。 Sub test(b, c, d) Dim i1, i2 As Long Dim A1 As String  For i1=0 To Cells(Rows.Count, 1).End(xlUp).Row For i2 = 0 To 5 If Range(b).offset(i1, i2).Value = "x1" Or Range(c).offset(i1, i2).Value = "x1" Then A1 = "XXX" ElseIf Range(b).offset(i1, i2).Value = Range(c).offset(i1, i2).Value Then A1 = "YYY" Else A1 = "ZZZ" End If Range(d).offset(i1, i2).Value = A1 Next i2 Next i1 End Sub

  • 【Excel VBA】ワークシートの表示(続き)

    すみません。 追記が出来なかったため、コードの続きをこちらに記載します。 For i = 1 To 12 If actsht = tmp(i) Then Flag = 1 Anser = MsgBox("翌月分シートを作成しますか?", vbYesNo + vbDefaultButton1, "確認") If Anser = vbYes Then ActiveSheet.Copy After:=ActiveSheet ActiveSheet.Name = tmp(i + 1) Sheets(actsht).Tab.ColorIndex = 2 Sheets(actsht).Range("B3").Value = Sheets("Sheet2").Range("A1").Value Sheets(actsht).Range("B4").Value = Sheets("Sheet2").Range("A2").Value ActiveSheet.Range("A2").Select Exit For ElseIf Anser = vbNo Then Exit For End If End If Next If Flag = O Then MsgBox ("新しいワークシートを作成出来ません。") End If If actsht = tmp(i) Then If Sheets(元データ).Visible = False Then Sheets(元データ).Visible = True End If End If End Sub

  • エクセルVBAを教えて下さい

    エクセルの表で -AB C D E F 1年月--1801 2------ 3------ 4------ (-)は空欄でセルE1=18、F1=1とします。 コントロールボックスをつかって Private Sub Command登録_Click() Dim d1 As Long Dim d2 As Long Dim ret As Variant Dim FindValue As String Dim TotalAddress As String If Range("E1").Value = "" Or Range("F1").Value = "" Then MsgBox "該当する場所にデータが入っていません。", vbCritical Exit Sub End If d1 = Range("A65536").End(xlUp).Offset(1).Row d2 = Range("B65536").End(xlUp).Offset(1).Row FindValue = """" & Range("E1").Value & Range("F1").Value & """" TotalAddress = Range("A1").Resize(d1).Address & "&" & Range("B1").Resize(d1).Address ret = Evaluate("MATCH(" & FindValue & "," & TotalAddress & ",0)") If IsError(ret) Then Cells(d1, 1) = Range("E1").Value Cells(d2, 2) = Range("F1").Value Else MsgBox "既に同じ組み合せがあります。", vbInformation End If End Sub というものを作ったのですが、E1=18、F1=1及びコマンドボタンを別シートに作成し、上記の表への登録をできるようにしたいのですが、なにかいい方法はありませんか?

  • vbaの繰り返し処理について

    vbaです。 Sub Test1() Dim Str As String Dim Pnt1 As Long Dim Pnt2 As Long Str = Range("A1") Pnt1 = InStr(Str, "重 http://") If Pnt1 <= 0 Then Exit Sub Pnt2 = InStr(Pnt1, Str, "要") If Pnt2 <= 0 Then Range("B1") = Mid(Str, Pnt1 + 2) Else Range("B1") = Mid(Str, Pnt1 + 2, Pnt2 - (Pnt1 + 2)) End If End Sub という式でA1からA2.A3と下にURLが入っており空欄になるまで同じ処理をしたいのですがどのように変更すれば作動しますでしょうか?

  • エクセルVBAの条件指定が上手くいきません

    「7を超えたら、For Eachステートメントを抜けなさい」という条件を入れたいのですが、 7を超えても処理が継続し困っています。 勉強不足で申し訳ないですが、ご教授願います。 【やりたいこと】 まず、セルB1~D3までのセルの値(9つ)が、7を超えない条件で1を加算していきます。 加算したときの値はE~Gの列に貼り付けていきます。 7を超えた時点でFor Eachステートメントを抜けます。 また、B1~D3までのセルには計算式が入っており、A1に数字を入れると、 それぞれ異なる増え方をします。(計算式自体は$A$1+1.1、$A$1+2.1などシンプルなもの) Sub test() Dim i As Range Dim n As Long Dim x As Long n = 1 x = 1 For Each i In Range("B1:D3") Range("A1").Value = x If i < 7 Then Range("B1:D3").Copy Cells(n, 5).Select Selection.PasteSpecial Paste:=xlPasteValues n = n + 3 x = x + 1 ElseIf i > 7 Then Exit For End If Next End Sub お手数ですが、宜しくお願いいたします。

専門家に質問してみよう