- 締切済み
excel vba thenが実行されない
No=1 for r=1 to 13 for c=1 to 13 select case masu(r,c) case 16 for n=-1 to 1 masu(r+2,c+n)=masu(r+2,c+n)+1 if r+2=a and c+n=b then p(No,1)=r:p(No,2)=c:No=No+1 next n end select next c next r 上記でif r+2=a and c+n=bの条件を成立させてもthenが実行されず、 r+2をr-2にして、if r-2=a and c+n=bの条件を成立させるとthenが実行される。 masu(r+2,c+n)=masu(r+2,c+n)+1はいずれの場合も実行される。 マクロはいずれもエラーとならず最後まで実行される。（r±、c±はインデックスの範囲内） 他のcase（16以外）でもr-の場合は実行され、r+の場合は実行されない。（if r+1=a and c+n=b then等） 原因がわからないのですが、どんなことが考えられるでしょうか。
- kana14
- お礼率98% (158/161)
- その他MS Office製品
- 回答数2
- ありがとう数3
- みんなの回答 （2）
- 専門家の回答
みんなの回答
- lupin-333333
- ベストアンサー率31% (294/933)
- ShowMeHow
- ベストアンサー率28% (1424/5027)
上記コードでは a と b の値がわかりませんので何故といわれてもわかりませんが、 http://www.excel-excel.com/vbachair/step1-7.html デバッグモードで実行しステップモードで観察しながら調べるか、 それぞれの値がどのように変化しているか、 debug.print などのコードを埋め込んでイミディエィトウインドウなどに出力することを お勧めします。 if r+2=a and c+n=b then p(No,1)=r:p(No,2)=c:No=No+1 Debug.Print "r = " & r & " a = " & a & " c = " & c & " n = " & n & " b = " & b end if みたいにね
お礼
回答いただきまして有難うございます。
補足
aとbは可変です。 正常に動作していたモジュール1とモジュール2を elseifで条件分岐して１つにしました。 if x=1 then 構文200行 elseif x=2 then 構文200行 end if
関連するQ&A
- エクセルマクロで定義した関数が動きません
以前にマクロの記述について教えて頂いた件の続きになります． ご指導頂いたとおりExcelマクロで複素数を扱う関数を下記HPから 標準モジュールにコピペしました．今度は正しくコピーできたと思いますが， 実行するとエラーになります． 標準の組込み関数を用いて「実数」の行列を計算すれば正しく 計算できますが，当然ながら「複素数」は計算できません． この「複素数」を扱う新しく定義した関数が動かない理由， 「End if に対するifブロックがありません」とか 計算結果が「#VALUE!」となってしまうのは何故でしょうか？ マクロの記述内容はほとんど理解できないのですが， どなたか助けて頂けませんか！ ちなみにエクセルは2016版です． http://www.geocities.jp/tomtomf/denki/AC2/ac2.htm http://www.geocities.jp/tomtomf/denki/AC1/ac1.htm 以下はコピー定義した「 IMMULT」関数と「 IMINVERS」関数のマクロです． Public Function IMMULT(a As Range, b As Range) As Variant Dim r1 As Integer, r2 As Integer, c1 As Integer, c2 As Integer, nn As Integer Dim r As Integer, c As Integer Dim cr As Integer, cc As Integer Dim n As Integer Dim mm() As Variant r1 = a.Rows.Count r2 = b.Rows.Count c1 = a.Columns.Count c2 = b.Columns.Count If (c1 = r2) Then nn = c1 Else Exit Function End If cr = r1 cc = c2 ReDim mm(1 To cr, 1 To cc) For r = 1 To cr For c = 1 To cc mm(r, c) = 0 For n = 1 To nn mm(r, c) = IMSUMa(mm(r, c), IMPRODUCTa(a.Cells(r, n), b.Cells(n, c))) Next Next Next IMMULT = mm End Function Public Function IMINVERS(a As Range) As Variant Dim n As Integer, n1 As Integer, n2 As Integer Dim r1 As Integer, r2 As Integer, c As Integer Dim max As Variant Dim i As Integer Dim m() As Variant Dim inm() As Variant Dim rr As Integer, cc As Integer Dim no As Integer, ex As Variant n1 = a.Rows.Count n2 = a.Columns.Count n = n1 ReDim inm(1 To n1, 1 To n2) For rr = 1 To n1 For cc = 1 To n2 If rr <> cc Then inm(rr, cc) = 0 Else inm(rr, cc) = 1 'End If Next Next ReDim m(1 To n1, 1 To n2) m = a If n1 <> n2 Then IMINVERS = False Exit Function End If For r1 = 1 To n max = m(r1, r1) no = r1 If r1 < n Then For i = r1 + 1 To n If IMABSa(m(i, r1)) > IMABSa(max) Then max = m(i, r1) no = i End If Next If (r1 <> no) Then For i = 1 To n ex = m(r1, i) m(r1, i) = m(no, i) m(no, i) = ex Debug.Print m(r1, i), m(no, i) ex = inm(r1, i) inm(r1, i) = inm(no, i) inm(no, i) = ex Next End If End If max = m(r1, r1) For i = 1 To n m(r1, i) = IMDIVa(m(r1, i), max) inm(r1, i) = IMDIVa(inm(r1, i), max) Next For r2 = 1 To n If r1 <> r2 Then max = m(r2, r1) For i = 1 To n m(r2, i) = IMSUBa(m(r2, i), IMPRODUCTa(m(r1, i), max)) inm(r2, i) = IMSUBa(inm(r2, i), IMPRODUCTa(inm(r1, i), max)) Next End If Next Next IMINVERS = inm End Function
- ベストアンサー
- Visual Basic
- このVBAソースのどこが間違ってるか教えてください
Dim csp As Integer 'ストップ Dim css As Integer 'ストップorスタート Sub Quest2() If css = 0 Then css = 1 Quest2a Else cstp = 1 css = 0 End If End Sub Sub Quest2a() Sheets("Sheet1").Select Range("B1:J10").Select Selection.Interior.ColorIndex = x1None Range("a1").Select cstp = 0 Do r = 1: c = 5 For i = 0 To 15 If i < 9 Then Cells(r, c).Interior.ColorIndex = x1None r = r + 1 If i < 5 Then c = c + 1 Else c = c - 1 End If Cells(r, c).Interior.ColorIndex = 3 Else Cells(r, c).Interior.ColorIndex = x1None r = r - 1 If i < 13 Then c = c - 1 Else c = c + 1 End If Cells().Interior.ColorIndex = 3 End If 'タイミング For tm1 = 1 To 1000: For tm2 = 1 To 100: Next If cstp = 1 Then Exit For End If Next DoEvents If cstp = 1 Then Exit For End If If r = 3 And c = 5 Then Cells(r, c).Interior.ColorIndex = x1None End If Next DoEvents If cstp = 1 Then Exit Do End If Loop Cells(10, 9) = Cells(r, c) Cells(10, 9).Interior.ColorIndex = 8 End Sub
- ベストアンサー
- その他（プログラミング・開発）
- ＥＸＣＥＬマクロ
下記は０～９が重複せずに３つ、順番も考慮してシートに出すものです。 いわゆる=PERMUT(10,3)、数学で言えば10P3を力技で求めるもの。 さて、３つ程度のループなら下記のようにｉｆを書いても良いのですが これが多重になればなるほど、ifが増えるので面倒になります。 なにか賢いアルゴリズムあったらご教示ください。 （使用目的は頭の体操、例えばポーカーの役の１回目に出る確率とかです。 本計算とは関係ありませんが、理屈で考えたものを検証したい為です。） Sub test() r = 2 For a = 0 To 9 For b = 0 To 9 If b = a Then GoTo 10 For c = 0 To 9 If c = a Then GoTo 20 If c = b Then GoTo 20 Cells(r, 1) = a Cells(r, 2) = b Cells(r, 3) = c r = r + 1 20 Next 10 Next Next End Sub
- 締切済み
- Visual Basic
- エクセルマクロについてです
以下のようなマクロで、条件A1～A4のいずれかを満たした場合は、その時点でFor-Nextを抜け（例えばi=1のときにどれかの条件を満たせばi=2,3,4は検討しない）、 さらにNの数字が増えたときに、If以下の検討をするとき、条件A1～A4の中で既に満たされた条件が含まれている行は無視する、 というようにしたいのですが、どのようにすればよいでしょうか。 N=0 Do Until N = 10 For i = 1 To 4 If 条件A1 Then B1 ElseIf 条件A2 Then B2 ElseIf 条件A3 Then B3 ElseIf 条件A4 Then B4 EndIf Next i N = N + 1 Loop
- ベストアンサー
- オフィス系ソフト
- ExcelのVBAがオーバーフローに！？
読んで頂きありがとうございます。 以前に質問しました時に回答を頂き凄く助かっていたのですが、何故か「オーバーフロー」と表示されてしまいます。 ひょっとしたら桁なのかも知れません。 下記のVBAを教えて頂きしようしていました。 Option Explicit Sub Test() Dim c(), p(), q(), i, j, l, r, k As Long r = Range("B2").End(xlDown).Row l = Range("D2").End(xlDown).Row ReDim c(r - 2), p(r - 2), q(r - 2) For i = 1 To r - 2 c(i) = Cells(i + 2, 2).Value p(i) = Cells(i + 2, 3).Value q(i) = i + 2 Next i For i = 1 To r - 3 For j = i + 1 To r - 2 If c(i) > c(j) Then k = c(i) c(i) = c(j) c(j) = k k = p(i) p(i) = p(j) p(j) = k k = q(i) q(i) = q(j) q(j) = k End If Next j Next i For i = 1 To r - 2 Cells(i + 2, 7).Value = c(i) For j = 3 To r If Cells(j, 4).Value = c(i) Then Cells(i + 2, 8).Value = p(i) - Cells(j, 5).Value If p(i) - Cells(j, 5).Value <> 0 Then Range("B" & q(i)).Interior.ColorIndex = 6 Range("D" & j).Interior.ColorIndex = 6 End If Exit For End If Next j Next i For i = 3 To r k = 0 For j = 3 To l If Cells(i, 2).Value = Cells(j, 4).Value Then k = 1 Exit For End If Next j If k = 0 Then Range("B" & i).Interior.ColorIndex = 35 End If Next i For i = 3 To l k = 0 For j = 3 To r If Cells(i, 4).Value = Cells(j, 2).Value Then k = 1 Exit For End If Next j If k = 0 Then Range("D" & i).Interior.ColorIndex = 35 End If Next i End Sub デパックのClickすると15行目辺りの「k = c(i)」が黄色くなります。 正直言ってマクロとか全く解りませんが、コピーして使っていました。 どこをどう変更すれば良いのか教えて頂ければ助かります。 よろしくお願いします。
- ベストアンサー
- Excel（エクセル）
- エクセルVBAについて
お世話になりなります。 以下のように条件が合わない場合、何もせずにNの値を増やして同じくIF文で判断する場合 ＊＊＊にどのように書けばいいのでしょうか？ よろしくお願いします。 Sub ボタン1_Click() Dim a As String For n = 1 To 30 a = Cells(n, 1) aa = Left(a, 1) aaa = Val(aa) If aaa = "" Then *** If aaa <= cha(30) Then *** If aaa >= cha(40) Then *** Else Cells(n, 3) = a Next End Sub
- ベストアンサー
- その他（プログラミング・開発）
- （Excel VBA）and,orについて
andとorを同時に使用する場合について質問です。 Case1) if A=1 and B=1 or C=1 then これは「Aが1かつBが1であるか、又はCが1であれば」という意味か 「Aが1であり、かつBが1であるか又はCが1であれば」という意味なのか どちらでしょうか。 Case2) if A=1 or B=1 and C=1 then 次に、この場合はどちらの意味でしょうか。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- VBA と JIS Full BASIC
下のJIS Full Basic スタイルとだいたい同じようなコードを VBA で書いたのですが Z = Sqr(x^2 + y^2) のところでエラーが出ます。どこがおかしいのでしょうか。 Function gcd(a, b) Do While b <> 0 r = a Mod b a = b b = r Loop gcd = a End Function Rem 既約なピタゴラス数を求める Sub Pythagoras() LAST = 200 LAST = 200 For x = 1 To LAST For y = x + 1 To LAST Z = Sqr(x^2 + y^2) 'ここでコンパイルエラーが出る If Int(Z) = Z Then If gcd(x, y) = 1 And gcd(x, z) = 1 And gcd(y, z) = 1 Then Debug.Print x & ", " & y & ", " & z End If End If Next y Next x End Sub ---------------------------- JIS Full Basic スタイルのコード REM ピタゴラス数 FUNCTION gcd(a,b) DO WHILE b <> 0 LET r = MOD(a,b) LET a = b LET b = r LOOP LET gcd = a END FUNCTION LET LAST = 200 FOR x = 1 TO LAST FOR y = x + 1 TO LAST LET z = SQR(x^2+y^2) IF INT(z) = z THEN IF gcd(x,y) = 1 AND gcd(x,z) = 1 AND gcd(y,z) = 1 THEN PRINT x,y,z END IF END IF NEXT y NEXT x END
- ベストアンサー
- Visual Basic
- エクセルVBA
A列を基準にBC列が空白ならAの数値を入れて、A>BならB列を更新、A<CならC列を更新 A列が数値以外ならその行をスキップ、という処理をしたいのですが Option Explicit Dim A As Range, B As Range, C As Range Dim i As Long Sub test() For i = 1 To 10 Set A = Cells(i, 1) Set B = A.Offset(0, 1) Set C = A.Offset(0, 2) If IsNumeric(A) Then Else Exit Sub End If If B.Value = "" Then B.Value = A.Value If C.Value = "" Then C.Value = A.Value If A.Value > B.Value Then B.Value = A.Value If A.Value < C.Value Then C.Value = A.Value Next i End Sub とすると数値以外の行の時点で停止してしまいます。 その行を飛ばして次の行に進むにはどうしたらいいのでしょうか？
- ベストアンサー
- Visual Basic
- エクセルVBAで複数シートにマクロ実行
エクセル2000です。 Sub 行列非表示() For i = 2 To 120 If Cells(i, "A").Interior.ColorIndex = 3 Then Cells(i, "A").EntireRow.Hidden = True End If Next i For n = 1 To 50 If Cells(1, n).Interior.ColorIndex = 3 Then Cells(1, n).EntireColumn.Hidden = True End If Next n End Sub 上記マクロを、シートAAAとCCCとEEEに実行する場合、 Sub test() Sheets("AAA").Activate Call 行列非表示 Sheets("CCC").Activate Call 行列非表示 Sheets("EEE").Activate Call 行列非表示 End Sub と書くよりももっとすっきり実行する方法は無いでしょうか？ 各シートの非表示対象の行や列はそれぞれことなります。 また Sub 行列非表示 自体も、もっと効率的にやる方法はないでしょうか？
- ベストアンサー
- オフィス系ソフト
お礼
回答いただきましてありがとうございます。
補足
cells(r,c)の値を配列(r,c,1)に、書式を数値化(MＳ 明朝=1、@ＭＳ 明朝=2)して、配列(r,c,2)にしたら、p(No,1)とp(No,2)には「０(ゼロ)」しか入らなくなりました。