VBAについて質問です。

Question

aiomock

269

267もっと見る

135pt

コンピュータインターネット

VBAについて質問です。

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

回答の条件

1人2回まで

登録：2010/01/17 14:25:44
終了：2010/01/21 20:26:54

※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

No.1

ammunition102010/01/17 14:56:37

35pt

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

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

\:*?"<>|

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

ファイル名なのですが　

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

そしてセルＢに　以下で表示させていただいたＨＴＭＬが入っています。

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

どうにかしてｈｔｍｌをそのまま保存したいのですが、、。

2010/01/17 16:26:13

aiomock 2010/01/17 14:26:57

動作していたプログラムは以下になります。

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
aiomock 2010/01/17 14:27:53

問題として挙げられているのは

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

の部分で実行すると、型が一致しませんというエラーダイアログが出てきます。
aiomock 2010/01/17 16:28:16

セルに入っている文字は以下のようなものです。

"<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>"
jccrh1 2010/01/17 18:36:04

私がテストしたら問題なく終了しました。
aiomockさんのシートの内容が分かりませんが…
以下のようなデータでは問題なく終了しました。

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

A2:0001
B2:

A3:
B3:
------------
aiomock 2010/01/18 04:43:25

jccrh1 さん

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

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

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

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

お手数をおかけし申し訳ありませんがわかるかたおりましたらお願いいたします。
SALINGER 2010/01/18 09:13:59

エラーが出たセルはエラー値という型になるので、Replaceで前述のエラーとなるわけです。
回答でしたようにエラー値を判別する方法以外に
ValueではなくTextにして＃N/Aの文字列をそのまま取り出す方法もあります。

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

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

リクエスト送信済

回答リクエストを送信したユーザーはいません

SALINGER · Accepted Answer · 2010-01-18T08:20:20+09:00

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

エラーで止まった場合、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

SALINGER · Accepted Answer · 2010-01-18T08:20:20+09:00

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

エラーで止まった場合、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

VBAについて質問です。

ベストアンサー

SALINGER34549692010/01/18 08:20:20

その他の回答（1件）

ammunition102010/01/17 14:56:37

SALINGER34549692010/01/18 08:20:20ここでベストアンサー

コメント（6件)

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