VBAについて質問です。

過去にtxtを大量に作成することが出来るマクロを作成していただきました。
http://q.hatena.ne.jp/1216705790
久しぶりにこのマクロを使用したところtxt作成が出来ず、困っております。
プログラムを実行すると型が一致しませんというエラーダイアログが出てきます。
多分自分がセルに入れているデータの特性に合った命令文がされていないからだと思うのですが、、、
(なんでもない文字列だったら通常に実行できるので・・)
大変お手数をおかけしますが詳しい方がおりましたらマクロのプログラムを一度見ていただけないでしょうか。
よろしくお願いいたします。

回答の条件
  • 1人2回まで
  • 登録:2010/01/17 14:25:44
  • 終了:2010/01/21 20:26:54

ベストアンサー

id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692010/01/18 08:20:20

ポイント100pt

なるほど、ワークシートのエラー値が問題になってましたか。

エラーで止まった場合、iの値にカーソルを合わせるとどの行で止まったかがわかるので

問題解決の近道になったですね。

#N/Aが出た場合を判別するようにすればいいです。

またここではやっていませんが、他のエラーが出た場合はiserror関数で判別すればいいです。


Option Explicit

Sub TxtSave()
    Dim FSO
    Dim i As Long
    Dim Shell As Object
    Dim FolderPath
    
    Set Shell = CreateObject("Shell.Application") _
        .BrowseForFolder(0, "フォルダを選択してください", 0, "c:\")
    
    If Shell Is Nothing Then
        Exit Sub
    Else
        FolderPath = Shell.Items.Item.Path
    End If
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    i = 1
    While ActiveSheet.Cells(i, 1).Value <> ""
        With FSO.getfolder(FolderPath).createtextfile(ActiveSheet.Cells(i, 1).Value & ".txt")
            If Application.WorksheetFunction.IsNA(ActiveSheet.Cells(i, 2)) Then
                .write "#N/A"
            Else
                .write Replace(ActiveSheet.Cells(i, 2).Value, vbLf, vbCrLf)
            End If
        End With
        i = i + 1
    Wend
    Set FSO = Nothing
End Sub
id:aiomock

ご回答ありがとうございます。

2010/01/18 23:30:57

その他の回答(1件)

id:ammunition No.1

ammunition回答回数1ベストアンサー獲得回数02010/01/17 14:56:37

ポイント35pt

ソースを見たところ、[セル内文字列.txt]で保存しようとしていますが、Windowsのファイル名に記号が使用出来ないためにエラーとなっているようです。

具体的には、以下が記号とみなされるようです。

\:*?"<>|

id:aiomock

ご回答ありがとうございます。

ファイル名なのですが 

セルAに数字が入っており [セル内文字列.txt]で保存は 数字.txt で保存をするということになっています。

そしてセルBに 以下で表示させていただいたHTMLが入っています。

セルに記号が入っている場合は何らかの処理を施さないといけないということでしょうか?

どうにかしてhtmlをそのまま保存したいのですが、、。

2010/01/17 16:26:13
id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692010/01/18 08:20:20ここでベストアンサー

ポイント100pt

なるほど、ワークシートのエラー値が問題になってましたか。

エラーで止まった場合、iの値にカーソルを合わせるとどの行で止まったかがわかるので

問題解決の近道になったですね。

#N/Aが出た場合を判別するようにすればいいです。

またここではやっていませんが、他のエラーが出た場合はiserror関数で判別すればいいです。


Option Explicit

Sub TxtSave()
    Dim FSO
    Dim i As Long
    Dim Shell As Object
    Dim FolderPath
    
    Set Shell = CreateObject("Shell.Application") _
        .BrowseForFolder(0, "フォルダを選択してください", 0, "c:\")
    
    If Shell Is Nothing Then
        Exit Sub
    Else
        FolderPath = Shell.Items.Item.Path
    End If
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    i = 1
    While ActiveSheet.Cells(i, 1).Value <> ""
        With FSO.getfolder(FolderPath).createtextfile(ActiveSheet.Cells(i, 1).Value & ".txt")
            If Application.WorksheetFunction.IsNA(ActiveSheet.Cells(i, 2)) Then
                .write "#N/A"
            Else
                .write Replace(ActiveSheet.Cells(i, 2).Value, vbLf, vbCrLf)
            End If
        End With
        i = i + 1
    Wend
    Set FSO = Nothing
End Sub
id:aiomock

ご回答ありがとうございます。

2010/01/18 23:30:57
  • id:aiomock
    動作していたプログラムは以下になります。

    Option Explicit

    Sub TxtSave()
    Dim FSO
    Dim i As Long
    Dim Shell As Object
    Dim FolderPath

    Set Shell = CreateObject("Shell.Application") _
    .BrowseForFolder(0, "フォルダを選択してください", 0, "d:\")

    If Shell Is Nothing Then
    Exit Sub
    Else
    FolderPath = Shell.Items.Item.Path
    End If

    Set FSO = CreateObject("Scripting.FileSystemObject")

    i = 1
    While ActiveSheet.Cells(i, 1).Value <> ""
    With FSO.getfolder(FolderPath).createtextfile(ActiveSheet.Cells(i, 1).Value & ".txt")
    .write Replace(ActiveSheet.Cells(i, 2).Value, vbLf, vbCrLf)
    End With
    i = i + 1
    Wend
    Set FSO = Nothing
    End Sub

  • id:aiomock
    問題として挙げられているのは

    .write Replace(ActiveSheet.Cells(i, 2).Value, vbLf, vbCrLf)

    の部分で実行すると、型が一致しませんというエラーダイアログが出てきます。
  • id:aiomock
    セルに入っている文字は以下のようなものです。


    "<html>
    <head>
    <meta content=""text/html;charset=Shift_JIS"" http-equiv=""Content-Type"">
    <title></title>
    </head>
    <body>
    <div class=""modUsrPrv"">
    <table border=""0"" cellpadding=""0"" cellspacing=""0"" width=""100%"">
    <tbody>
    <tr>
    <td>
    <p>
    <table>
    <tbody>
    <tr>
    <td>
    <table border=""10"" cellpadding=""5"" cellspacing=""0""
    width=""586"">
    <tbody>
    <tr>
    <td colspan=""4"" rowspan=""1"" align=""center""
    bgcolor=""black""><font color=""white"">☆★☆</font><font color=""white""> 商品情報
     </font><font color=""white"">☆★☆</font></td>
    </tr>
    <tr>
    <td align=""center"" bgcolor=""black"" width=""200""><font
    color=""white""><b>市場価格</b></font> </td>
    <td align=""right"" width=""100""><b><font color=""red"" size=""+3"">2000</font>円</b></td>
    <td align=""center"" bgcolor=""black"" width=""120""><b><font
    color=""white"">ブランド名</font></b></td>
    <td align=""right"" bgcolor=""white"" width=""180""><big><span
    style=""font-weight: bold;"">SPALDING スパルディング</span></big><br>
    </td>
    </tr>
    <tr>
    <td align=""center"" bgcolor=""black""><font color=""white""><b>生
    産国</b></font></td>
    <td align=""right"" bgcolor=""white"" width=""180""><b>/</b></td>
    <td align=""center"" bgcolor=""black"" width=""120""><font
    color=""white""><b>素
    材/色</b></font> </td>
    <td align=""right"" width=""180""><b>樹脂/キャラメルの強いブラウン</b></td>
    </tr>
    <tr>
    <td align=""center"" bgcolor=""black""><font color=""white""><b>商
    品サイズ</b></font> </td>
    <td colspan=""3"" align=""left"" width=""180""><b>縦:11cm 横:18cm マチ:2cm</b></td>
    </tr>
    <tr>
    <td align=""center"" bgcolor=""black""><font color=""white""><b>発

    料金の確認</b></font> </td>
    <td colspan=""3"" bgcolor=""#ffcc33""><big><b><a
    href=""http://oskuni7.sakura.ne.jp/MAILFORM/Souryou.php""
    target=""new"">★送料を確認する★</a> ←送料をご確認下さい。<br>
    </b></big></td>
    </tr>
    </tbody>
    </table>
    <br>
    <div style=""text-align: center;""><br>
    <big><b><big><small> < その他商品出品しております^^ ></small></big></b></big>
    <a href=""http://auctions.yahoo.co.jp/jp/booth/e""
    target=""new""><img alt=""マイ・オークションをごらんください""
    src=""http://image.auctions.yahoo.co.jp/banner.gif""></a><br>
    </div>
    <br>
    </td>
    <td width=""20""><br>
    </td>
    <td>
    <table border=""3"" cellpadding=""5"" cellspacing=""0"">
    <tbody>
    <tr>
    <td align=""center"" bgcolor=""black""><font color=""white"">☆★☆
     商品の特徴 ☆★☆</font> </td>
    </tr>
    <tr>
    <td><br>
    <big><big><b>★未使用の商品になります。<br>
    <br>
    </b></big></big><big><big><b>★タグが付いております。<br>
    <br>
    </b></big></big><big><big><b>0<br>
    <br>
    </b></big></big><big><big><b>0</b></big></big><br>
    </td>
    </tr>
    </tbody>
    </table>
    </td>
    </tr>
    </tbody>
    </table>
    </p>
    <div></div>
    </td>
    </tr>
    </tbody>
    </table>
    </div>
    </body>
    </html>"
  • id:jccrh1
    私がテストしたら問題なく終了しました。
    aiomockさんのシートの内容が分かりませんが…
    以下のようなデータでは問題なく終了しました。

    ------------
    A1:0000
    B1:上記のHTMLデータ

    A2:0001
    B2:

    A3:
    B3:
    ------------

  • id:aiomock
    jccrh1 さん

    ご回答ありがとうございます。
    私のほうでも実行することができました。

    実はB列の値をVLOOK関数で反映をさせており エラー判定が出ているところも一緒にtxtデータとして作成しようとしていることが問題でした。

    しかし、#N/A というエラー判定の文字も出来ればtxtデータに入れられれば楽なのですが
    貼り付け→値のみ にして先ほどのマクロを実行してもデータを入れることが出来ません。

    #N/A という文字列は何かエラーを発生させる要素を持っているのでしょうか?

    お手数をおかけし申し訳ありませんがわかるかたおりましたらお願いいたします。
  • id:SALINGER
    エラーが出たセルはエラー値という型になるので、Replaceで前述のエラーとなるわけです。
    回答でしたようにエラー値を判別する方法以外に
    ValueではなくTextにして#N/Aの文字列をそのまま取り出す方法もあります。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません