ExcelのVBAがオーバーフローに!?

このQ&Aのポイント
  • 以前に質問しました時に回答を頂き凄く助かっていたのですが、何故か「オーバーフロー」と表示されてしまいます。
  • 下記のVBAを教えて頂きしようしていました。
  • デパックのClickすると15行目辺りの「k = c(i)」が黄色くなります。正直言ってマクロとか全く解りませんが、コピーして使っていました。どこをどう変更すれば良いのか教えて頂ければ助かります。
回答を見る
  • ベストアンサー

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)」が黄色くなります。 正直言ってマクロとか全く解りませんが、コピーして使っていました。 どこをどう変更すれば良いのか教えて頂ければ助かります。 よろしくお願いします。

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

  • ベストアンサー
回答No.2

3行目の Dim c(), p(), q(), i, j, l, r, k As Long を Dim c(), p(), q(), i, j, l, r, k とすれば動くと思います。

Naomi1995
質問者

お礼

早速のご回答ありがとうございました。 上手く動いているようです。 助かりました。 本当にありがとうございました。

その他の回答 (1)

  • akauntook
  • ベストアンサー率19% (295/1481)
回答No.1

http://www.officepro.jp/excelvba/ 正直で良いですね。参考にどうぞ。 私も正直に。 丸投げは嫌いなので、質問の通りにはしたくありません。 こう書くと、天の邪鬼な方がやってくれるかもしれないです。 あと、どこかのサンプルをコピペしたなら、そのサイトとURLを貼った方が良いですよ。 インデントされていないコードは読む気が下がります。 >「オーバーフロー」と表示されてしまいます オーバーフローとだけエラーが表示されたわけではないでしょう。正確に表示されたままを書きましょう。 >デパックのClickすると デバッグですよね。 この程度ならわかると思いますが、ソースコードの質問のものと、実際に書いたもので同じようなミスもありそうです。 あとは、実際のExcelブックの内容や、Excelのバージョン等も書いておくと良いと思います。

Naomi1995
質問者

お礼

色々とアドバイスありがとうございました。 大変失礼な質問文になってしまい申訳ありませんでした。 また何かありましたら質問させて頂きます。 その時はもっと正確に記載するよう心掛けます。

関連するQ&A

  • VBAtest

    VBAおn以下の Sheets("OP").Select Dim atai As String atai = Cells(2, 2).Value Dim datedata(40) As String For j = 0 To 40 If Cells(j + 3, 2).Value = "" Then Else datedata(j) = Cells(j + 3, 2).Value End If Next Dim shihyou As String For i = 1 To 2 shihyou = Cells(2, i + 2).Cells.Value Sheets(shihyou).Select Dim tmp_c As Integer For r = 1 To 10 tmp_c = 0 For c = 1 To 10 If tmp_c = 0 Then If Sheets(shihyou).Cells(r, c).Value = atai Then tmp_c = c End If Else Dim vals(40) As String For k = 0 To 40 For l = 1 To r + 41 For m = 1 To tmp_c - 1 If Sheets(shihyou).Cells(l, m).Value = datedata(k) Then vals(k) = Sheets(shihyou).Cells(l, tmp_c).Value End If Next Next Next End If Next Next Sheets("OP").Select For k = 3 To 43 Cells(k, i + 2).Value = vals(k - 3) Next Next End Sub

  • VBA For~Next 

    「wsData」の値を「wsInv」の指定セル(=●●●=16)から4つおきに処理したい。 01:Cells(16 + i * 4, 1) とすると「i」が大きいときに   「""」があると16からスタートしない 02:「For k = 0 To 50」を作成したが、何処に入れても上手く処理出来ない。 For i = 0 To 50 '行 For j = 6 To 28 '列 If wsData.Cells(10 + i, 3).Value = "" Then wsInv.Cells(●●●, 1).Value = wsData.Cells(10 + i, 1).Value wsInv.Cells(●●●, j - 2).Value = wsData.Cells(10 + i, 23 + j).Value End If Next j Next i お力添えをお願いいたします。

  • エクセルVBAの配列について

    エクセルVBAの配列について VBAをはじめたばかりの初心者です。 現在、下記のようにデータを配列の中に入れ、 別シートに書き出そうとしております。 (配列へ読み込むところのみ) Dim 配列(1 To 件数, 1 To 9) As Variant For j =1 To 件数 For i = 2 To L If Cells(i, 2).Value = Tx_month Then For k = 3 To 11 配列(j, k - 2) = Cells(i, k).Value Next k End If Next j,i 現状では、データの最終行のみを「件数」分書き出してしまいます。 jとiのForが重なっているからだと思うのですが、どう書き直したら良いか分かりません。 質問をさせていただくのも初めてなので、分かりづらく恐縮ですが お力添え頂けますと幸いです。 どうぞ宜しくお願い致します。

  • エクセルVBAを修正したい

    数字を入力すると記号に変換になるマクロを 元ファイルを修正して作成したいのですが、 同一シートにC9:M33,C9:Y25,O27:Y29といった 範囲の異なる表がある場合はセル範囲をどのように記述すれば良いでしょうか? StartCol = 4 '開始列 EndCol = 20 '終了列 BlankCount = 0 I = 16 '開始行 L = 14 '行の指定 Do While Len(Range("B" & CStr(I)) & Range("C" & CStr(I))) > 0 For J = StartCol To EndCol If Len(ActiveSheet.Cells(L, J).Value & ActiveSheet.Cells(L + 1,J).Value) > 0 Then tmp = "" If ActiveSheet.Cells(I, J).Value = "×" Or ActiveSheet.Cells(I,J).Value = "中止" Then Else If Len(ActiveSheet.Cells(I, J).Value) = 0 Then K = -1 Else K = ActiveSheet.Cells(I, J).Value End If Select Case K Case 0 tmp = "×" Case 1 To 14 tmp = "△" Case Is >= 15 tmp = "○" End Select End If Next I = I + 1 If Len(Range("B" & CStr(I)) & Range("C" & CStr(I))) = 0 Then L = I + 1 I = I + 3 End If Loop End Sub

  • エクセルVBAを修正したい

    数字を入力すると記号に変換になるマクロを 元ファイルを修正して作成したいのですが、 以下の記述が理解できません。 具体的にどのような処理をしているのか教えて下さい。 Do While Len(Range("C" & CStr(I)) & Range("D" & CStr(I))) > 0 For J = StartCol To EndCol If Len(ActiveSheet.Cells(12, J).Value & ActiveSheet.Cells(13, J).Value) > 0 Then tmp = "" If ActiveSheet.Cells(I, J).Value = "×" Or ActiveSheet.Cells(I, J).Value = "中止" Then ' ActiveSheet.Cells(I, J).Value = "中止" 'ActiveSheet.Cells(I, J + 1).Value = "" Else If Len(ActiveSheet.Cells(I, J).Value) = 0 Then K = -1 Else K = ActiveSheet.Cells(I, J).Value End If Select Case K Case 0 tmp = "×" Case 1 To 9 tmp = "△" Case Is >= 10 tmp = "○" Case Is < 0 tmp = "**" End Select

  • EXCEL VBA2010 MsgBox

    Sub 重複() Dim i As Long, j As Long For i = 6 To 500 For j = 3 To 3 If WorksheetFunction.CountIf(Range("C6:C500"), Cells(i, j)) > 1 Then Cells(i, j).Interior.ColorIndex = 6 End If Next j Next i End Sub このVBAに重複が何件ありますよというメッセージを出したいです。 MsgBoxの入れ方を教えてください。

  • エクセルのVBA、ループ処理について

    if文とループ処理をどう組み合わせればいいのかわかりません 以下のコードで、iの数をを増やしていく処理を行いたいのですが、エラーがでてしまいうまくいきません どのように書けばいいのでしょうか 教えてください For i = 2 To 11 If Cells("4,i") > 80 Then Cells("5,i").Value = "A" ElseIf Cells("4,i") > 70 Then Cells("5,i").Value = "B" ElseIf Cells("4,i") > 60 Then Cells("5,i").Value = "C" Else Cells("4,i").Value = "D" End If Next

  • この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

  • 2つのVBAを組み合わせる方法

    お世話になります、2つのVBAを組み合わせる方法で迷っています。 1つ目が Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long, k As Long, myNum As Long If Intersect(Target, Range("C1,B9:B39")) Is Nothing Or Target.Count > 1 Then Exit Sub Application.EnableEvents = False With Target If .Column = 3 Then myNum = WorksheetFunction.Max(Range("B9:B39")) If IsDate(.Value) Then For i = 9 To 39 If Cells(i, "A").Value = "" Then Cells(i, "B").Value = "" Else Cells(i, "B") = myNum + i - 8 End If Next i End If Else i = .Row If .Value = "" Then Range(Cells(i + 1, "B"), Cells(39, "B")).ClearContents Else For k = i + 1 To 39 If Cells(k, "A").Value = "" Then Cells(k, "B").Value = "" Else Cells(k, "B") = Cells(k - 1, "B") + 1 End If Next k End If End If End With Application.EnableEvents = True End Sub です。 2つめが Private Sub Worksheet_Change(ByVal Target As Range)  Application.EnableEvents = True If Intersect(Target, Range("R8:R38")) Is Nothing Then Exit Sub Application.EnableEvents = False Range(Cells(Target.Row, 18), Cells(39, 18)).Value = Target.Value Application.EnableEvents = True End Sub です。2つのPrivate Sub Worksheet_Change(ByVal Target As Range)イベントのVBAですが、どのようにして組み合わせれば良いのでしょうか?

  • Excel VBAで検索する

    Excel VBAで、Sheet1に貼り付けたテキスト内から Sheet2に記載した(1列ごとの)キーワードを検索し キーワードが含まれている行をSheet3に貼り付ける処理をしているのですが、始めたばかりなので上手くいきません。 下記がソースです。 Dim moji As String Dim word As String Dim result As Integer For i = 3 To 103 For j = 2 To 21 moji = ThisWorkbook.Worksheets("Sheet1").Cells (i, 1).Value word = ThisWorkbook.Worksheets("Sheet2").Cells (j, 2).Value result = InStr(moji, word) If doResult <> 0 Then For k = 1 To 100 ThisWorkbook.Worksheets("Sheet3").Cells (k, 1).Value= moji Next k End If Next j Next i このソースでは上手くいかないのですが、どこがダメなのか分からないので、解決の糸口がつかめません。 アドバイスなどお願いします。

専門家に質問してみよう