実行時エラー'6' オーバーフローしました

このQ&Aのポイント
  • 米国の知人に組んでもらったマクロなのですが、データを取り込むときに「実行時エラー'6' オーバーフローしました」のエラーメッセージが表示されます。
  • なぜかその知人のPCでは同じデータを取り込んで、計算等の操作が可能です。ソルバーアドインの設定等のアドバイスを受け、いろいろ試してみたのですが、解決できません。
  • OSやOfficeが日本語版と英語版の違いで起こる可能性が高いよう思われるのですが、原因が皆目見当つきません。デバッグを実行すると「bp = Asc(Mid(Pass, ip, 1))」が黄色くハイライトされます。解決方法がわかる方がいらっしゃいましたら、回答下さい。宜しくお願い致します。
回答を見る
  • ベストアンサー

オーバーフローで困っています

米国の知人に組んでもらったマクロなのですが、 データを取り込むときに「実行時エラー'6' オーバーフローしました」の エラーメッセージが表示されます。 なぜかその知人のPCでは同じデータを取り込んで、計算等の操作が可能です。 ソルバーアドインの設定等のアドバイスを受け、いろいろ試してみたのですが、 解決できません。 OSやOfficeが日本語版と英語版の違いで起こる可能性が高いよう思われるのですが、原因が皆目見当つきません。 デバッグを実行すると「bp = Asc(Mid(Pass, ip, 1))」が黄色くハイライトされます。(下記参照)  解決方法がわかる方がいらっしゃいましたら、回答下さい。 宜しくお願い致します。 While (InStr(1, Pass, Chr(13)) = 1) Pass = Mid(Pass, 2) Wend If (Len(Pass)) Then Pass = Pass & Chr(13) End If l = Len(t) While (Len(Pass)) lp = InStr(1, Pass, Chr(13)) s = "" i = 1 ip = 1 While (i <= l) If ip = lp Then ip = 1 bp = Asc(Mid(Pass, ip, 1)) (←このラインが黄色でハイライト) b1 = Asc(Mid(t, i, 1)) b2 = b1 Xor bp s = s & Chr(b2) i = i + 1 ip = ip + 1 Wend t = s Pass = Mid(Pass, lp + 1) While (InStr(1, Pass, Chr(13)) = 1) Pass = Mid(Pass, 2) Wend Wend s = "" For i = 1 To l b1 = Asc(Mid(t, i, 1)) s = s & Chr(b1 Xor bt) bt = IIf(bt = 255, 0, bt + 1) Next

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

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

米国人はアルファベットしか使わないからAsc()は0~127の範囲となる。 しかし、日本では漢字を使うためAsc()は-32768~32767の範囲となる。 対策は、 ・英数字のみとして漢字を使わない。 ・bp,b1,b2等をInteger型にする。 のどちらかです。

WaxMax
質問者

お礼

なるほどやはり日本語と英語の対応でエラーが発生していたということですね。 ということは、このライン以外にも類似するバグがある可能性が大きいですね。 対応策をマクロの作成者と相談してみます。 回答ありがとうございました。

関連するQ&A

  • VBへの変換の仕方 RS232C送信データとチェックサム

    以下のプログラムをVBに変換する仕方を教えてください。 サンプルプログラム 1110 CHKSUM=0 1120 FOR i=1 to LEN(A$)      'A$は送信データ 1130 CHKSUM=CHKSUM+ASC(MID$(A$,i,1) 1140 NEXT i 1150 C$=CHR$((CHKSUM+13) MOD 256) 1160 PRINT #1,A$;CHR$(13);C$; 私のVBプログラムは1110行から1150行まではそのままで CHKSUM=0 FOR i=1 TO LEN(A$) CHKSUM=CHKSUM+ASC(MID$(A$,i,1) NEXT i C$=CHR$((CHKSUM+13) MOD 256) としました。 送信部分を MSComm1.Output =A$ & CHR$(&H13) & C$ としてみましたが 1160行にあるセミコロン ";" はCHR$(&h3B) として送る必要があるのでしょうか? MSComm1.Output =A$ & CHR$(&h3B) & CHR$(&h13) ・・・・・・ また、データとしてA$="I 02"のチェックサムは "リ" となりますが正しいのでしょうか? 以上ご教示ください。

  • ファイルのパス名をダイアログボックスから選びたい

    下のコードの9行目のOPEN " "の中(ファイルのパス名が入る)を、ダイアログボックスから選べるようにするにはどうすればよいのでしょうか。至急、回答をお願いします。 Private Sub Command1_Click() Dim FileNo As Integer 'ファイル番号 Dim strDAT As String '行データ Dim strELM As String 'マルチステートメントの分解 Dim pot1 As Integer, pot2 As Integer '『:』、『OPEN』の位置 Dim pDB1 As Integer, pDB2 As Integer '『"』の位置(前と後) FileNo = FreeFile Open " " For Input As #FileNo 'ファイルをセットする While Not EOF(FileNo) Line Input #FileNo, strDAT '行データを読み込む strDAT = strDAT & ":" pot1 = InStr(strDAT, ":") 'マルチステートメント対応 While pot1 > 0 strELM = Left(strDAT, pot1) 'マルチステートメントの分解 pot2 = InStr(strELM, "OPEN") 'OPENの位置 While pot2 > 0 pDB1 = InStr(strELM, Chr(&H22)) '『"』の位置 If pDB1 > 0 Then '前の『"』の位置 pDB2 = InStr(pDB1 + 1, strELM, Chr(&H22)) If pDB2 > 0 Then '後ろの『"』があったら RichTextBox1.Text = RichTextBox1.Text & _ Mid(strELM, pDB1 + 1, pDB2 - pDB1 - 1) & vbCrLf End If End If pot2 = InStr(pDB2 + 1, strELM, "OPEN") 'OPENはもうないか Wend '次の命令文 strDAT = Mid(strDAT, pot1 + 1) pot1 = InStr(strDAT, ":") Wend Wend End Sub

  • ファイルを読み込んだらVBがフリーズする

    ↓のコードだと、ファイルを読み込んだ時点でVBがフリーズします(平気なファイルも一部ある)。原因と解決法を教えてください。 Private Sub Command1_Click() CommonDialog1.Filter = "テキスト(*.txt)|*.txt|すべて(*.*)|*.*" CommonDialog1.FilterIndex = 1 CommonDialog1.Flags = cdlONFileMustExist CommonDialog1.CancelError = True On Error Resume Next CommonDialog1.ShowOpen If (Err = 0) Then FileRead CommonDialog1.FileName End If On Error GoTo 0 End Sub Private Sub FileRead(FL As String) Dim FileNo As Integer Dim strDAT As String Dim strELM As String Dim pot1 As Integer, pot2 As Integer Dim pDB1 As Integer, pDB2 As Integer FileNo = FreeFile() Open FL For Input As #FileNo While Not EOF(FileNo) Line Input #FileNo, strDAT strDAT = strDAT & ":" pot1 = InStr(strDAT, ":") While pot1 > 0 strELM = Left(strDAT, pot1) pot2 = InStr(strELM, "OPEN") While pot2 > 0 pDB1 = InStr(strELM, Chr(&H22)) If pDB1 > 0 Then '前の『"』の位置 pDB2 = InStr(pDB1 + 1, strELM, Chr(&H22)) If pDB2 > 0 Then RichTextBox1.Text = RichTextBox1.Text & _ Mid(strELM, pDB1 + 1, pDB2 - pDB1 - 1) & vbCrLf End If End If pot2 = InStr(pDB2 + 1, strELM, "OPEN") Wend strDAT = Mid(strDAT, pot1 + 1) pot1 = InStr(strDAT, ":") Wend Wend Close #FileNo End Sub

  • Excel2007VBA「区」のところで改行したい

    ●質問の主旨 エクセルワークシートのB列にある任意の住所をD列に転記します。 転記の際に「区」のところで改行したいと思いますが、 自作のコードではその通りになりません。 どのように書き換えたら良いでしょうか? ご存知の方、ご教示願います。 ●質問の補足 1.「住所1」には必ず「区」の文字が入ります 2.Mid関数の第2引数にInStr(Cells(i, 2), "区")を 使っていますが、この引数に何を使えば良いのかが分かりません。 3.添付の画像は自作のコードを使った結果、 作成された住所で、意図通りの改行はできていません。 ●コード Sub Macro1() Dim i As Integer For i = 2 To 6 Cells(i, 4) = Left(Cells(i, 2), InStr(Cells(i, 2), "区")) _ & Chr(10) & Mid(Cells(i, 2), InStr(Cells(i, 2), "区")) Next i End Sub

  • ループを違う条件で抜けるようにしたい

    ファイルを読み込み、OPEN "*.*"(*=ワイルドカード)という文字列の*.*のみをリッチテキストボックスに出力するプログラムです。今のままだと、OPEN "ABC"+"Z.txt" などのように" "が同じ行(違う行にある" "は無視してよい)に2個以上あっても、最初の" "(この場合は"ABC"に"."が無いので、ABCは出力しなくて良いが、Z.txtは出力したい)で条件を抜けてしまいます。VBの初心者で、どうループを変えたらよいのかわからないので、どなたか教えてください。 Private Sub FileRead(FL As String) Dim Fileno As Integer 'ファイル番号 Dim strdat As String '行データ Dim pot1 As Integer '『OPEN』の位置 Dim pDB1 As Integer '1つ目の["] Dim pDB2 As Integer '2つ目の["] Dim dt As String Fileno = FreeFile Open FL For Input As #Fileno 'フォルダをセットする While Not EOF(Fileno) Line Input #Fileno, strdat '行データを読み込む pot1 = InStr(UCase(strdat), "OPEN") While (pot1 > 0) pDB1 = InStr(pot1 + 1, strdat, Chr(&H22)) If (pDB1 > 0) Then pDB2 = InStr(pDB1 + 1, strdat, Chr(&H22)) If (pDB2 > 0) Then dt = Mid(strdat, pDB1 + 1, pDB2 - pDB1 - 1) If (InStr(dt, ".")) Then '["]の間に[.]があるか RichTextBox1.Text = RichTextBox1.Text & dt & vbCrLf End If pot1 = pDB2 '2つ目の["] Else pot1 = pDB1 '1つ目の["] End If End If pot1 = InStr(pot1 + 1, strdat, Chr(&H22)) Wend Wend Close Fileno End Sub

  • 単位付きの合計金額をセル毎に振り分け

    いつもお世話になります。 Windows XP EXCELL2003 単位付きの合計金額をセル毎に振り分け見やすくしています。 現在、参照図(1)では百万単位で作成してうまくいきました。 但し位が十万 万 千となった時、参照図(2) この場合は十万の位ですが上手きゆきません。 エラーになります 下記に数式を表示していますのでどういう具合に修正すればいいかご指導を仰ぎたいです。 宜しく御願いします。 参考に D8 =IF($B$6<E$8,"\",E$8) E8 =MID(SUM(B3:B5),LEN(SUM(B3:B5))-6,1) F8 =MID(SUM(B3:B5),LEN(SUM(B3:B5))-5,1) G8 =MID(SUM(B3:B5),LEN(SUM(B3:B5))-4,1) H8 =MID(SUM(B3:B5),LEN(SUM(B3:B5))-3,1) I8 =MID(SUM(B3:B5),LEN(SUM(B3:B5))-2,1) J8 =MID(SUM(B3:B5),LEN(SUM(B3:B8))-1,1) K8 =MID(SUM(B3:B5),LEN(SUM(B3:B6)),1) という数式を入れています。

  • Excel・VBAで・・。

            A    |     B    |     C 1   あああ<>いい<>  |         | 2   あああ<>うう<>  |         | 3   えええ<>おお<>  |         |     A     |    B  |   C    |   D  | 1 あああ<>いい<> | あああ  | いい<>   | いい   | 2 あああ<>うう<> | あああ  | うう<>   | うう   | 3 えええ<>おお<> | えええ  | おお<>   | おお   | というようになるようにしたいのです。 そこで、こんな感じのコードをかきました。 i = 1 i2 = 1 Do While Cells(i, i2).Value <> "" Do While Cells(i, i2).Value <> "" Namae = Cells(i, i2).Value Point = InStr(1, Namae, "<>") Cells(i, i2 + 1).Value = Left(Namae, Point - 1) Cells(i, i2 + 2).Value = Mid(Namae, Point + 2) i = i + 1 Loop i2 = i2 + 2 Loop でもD列までいかないで、C列で止まってしまうんです。 1つ目のDo whileが原因かな?と思ってるんですが、どう直したらいいかわかりません。 よろしくお願いします。

  • テキストファイルの中からURLを抽出するには?

    VBAで読み込んだテキストファイルからURL部分だけを抽出するにはどうしたらよいでしょうか? InStr関数とMid関数を使って、先頭:http~終わり:空白 or Chr(13)をURLとして切り取っているのですがうまく行きません。 どうも終わり部分の判定が甘いようです。 Sub GetURL(myText)     'テキストからURLを抽出  Dim myText As String  Dim myURL As String   'URL取り込み用  Dim str_pt As Long     '文字列用ポインタ  str_pt = 1          '最初は1文字目から  Do While 1   str_pt = InStr(str_pt, myText, "http")   If str_pt = 0 Then Exit Do   Do While 1    letter = Mid(myText, str_pt, 1)    If letter = Chr(20) Or letter = Chr(13) Then Exit Do    myURL = myURL & letter    str_pt = str_pt + 1   Loop   Debug.Print myURL   myURL = ""  Loop End Sub アドバイスをお願いします!

  • VBAでShift-JISのURLエンコード

    Excelにおいて、マクロを使ってShint-JIS形式のエンコードを行いたいのですが その方法(ソース)がネット上で見つかりません。。どなたかご教授いただけないでしょか!  ※VBA(マクロ)について、ぜんぜん詳しくありません。。 検索 ⇒ %8c%9f%8d%f5 UTF-8の場合ならば、シンプルなものが見つかりました。 ----------------------------------------------------- Public Function UrlEncode(ByVal sText As String) As String If Len(sText) = 0 Then Exit Function With CreateObject("ScriptControl") .Language = "JScript" UrlEncode = .CodeObject.encodeURIComponent(sText) End With End Function また、デコードするものも見つかりました。 ----------------------------------------------------- Function URLDecodeSJIS(src) src = UnEscape(src) For i = 1 To Len(src) srcCh1 = AscW(Mid(src, i, 1)) If (&H0 <= srcCh1 And srcCh1 <= &H80) Or (&HA0 <= srcCh1 And srcCh1 <= &HDF) Then URLDecodeSJIS = URLDecodeSJIS & Chr(srcCh1) ElseIf (&H81 <= srcCh1 And srcCh1 <= &H9F) Or (&HE0 <= srcCh1 And srcCh1 <= &HFF) Then i = i + 1 srcCh2 = AscW(Mid(src, i, 1)) clcCh = srcCh1 * 256 + srcCh2 If (Asc(Chr(clcCh)) And &HFFFF&) = clcCh Then clcCh = Chr(clcCh) URLDecodeSJIS = URLDecodeSJIS & clcCh End If Next End Function Function UnEscape(s) With CreateObject("MSScriptControl.ScriptControl") .Language = "VBScript" .Reset UnEscape = .Eval("unescape(""" & s & """)") End With End Function よろしくお願い致します。

  • 「'」もascで変換させたい

    A1に「'test」と入れると「test」になってしまいます。 そして、 Sub test() Dim MojiInt As Long Dim i As Long Dim myRow As Long Dim Moji As String MojiInt = Len(Cells(1, 1)) For i = 1 To MojiInt Moji = Mid((Cells(1, 1)), i, 1) If i = 1 Then Cells(1, 2) = Asc(Moji) Else Cells(1, 2) = Cells(1, 2) & "," & Asc(Moji) End If Next i End Sub をすると、 116,101,115,116 になります。 最初の「'」もascで変換させることは無理なのでしょうか?