お世話になります。
下記のようにSQLで出力した内容を、WriteLineで書きだす際に
1行読む毎に、前の行と比較して、同じだったら空白にしたいです。

<前>
あああ AAA 0
あああ BBB 1
いいい AAA 0
いいい CCC 0
いいい CCC 2
ううう DDD 1


<後>
あああ   AAA  0
空白    BBB  1
いいい   AAA  0
空白    CCC  空白   
空白    空白   2
ううう   DDD  1

下記を実行していますが、3列目の数値部分が原因なのか
「型が一致していません」と出てしまいます。

必要な個所だけ載せます。
--------------------------------------------------------
1: For i = 1 To 3
2: testStr(i) = ts.Fields(i-1).Value
3: testStr2(i) = testStr(i)
4: if testStr(i) = testStr2(i) then
5: testStr(i) = ""
6: else
7: testStr2(i) = testStr(i)
8: end if
--------------------------------------------------------
  以降
testLine=testLine とtestStr(i)を結合して出力
Nextでループ

上記のi=3(3列目)になった時、3行目「testStr2(i) = tmpStr(i)」で比較した時に
「型が一致していません」エラーが出ます。
数値の場合は何か指定が違うでしょうか。

すみませんが、ご教授頂きたくよろしくお願いします。

質問者からの補足コメント

  • 回答ありがとうございます。
    直接打ったため、所々記載ミスしてしまいました。

    不明箇所1)不明箇所2)
    まず、下記3行目は不要でした。
    3: testStr2(i) = testStr(i)
    tmpStr(i)も打ち間違いで、testStr(i)です。

    不明箇所3)
    下記で宣言しています。
    Dim testStr(3)
    Dim testStr2(3)
    回答ありがとうございます。
    直接打ったため、所々記載ミスしてしまいました。

    1: For i = 1 To 3
    2: testStr(i) = ts.Fields(i-1).Value
    3: if testStr(i) = testStr2(i) then
    4: testStr(i) = ""
    5: else
    6: testStr2(i) = testStr(i)
    7: end if
    8: Next

    No.1の回答に寄せられた補足コメントです。 補足日時:2017/03/21 18:29

このQ&Aに関連する最新のQ&A

A 回答 (5件)

#4 の


[#1の回答者です。] -> は、[#2....]の間違いです。
#1様、番号間違いすみません。

ともかく気になることだけが頭に残っていたもので、失礼しました。ふだん、VBSではやったことがありませんでしたので、勉強がてらやってみました。

以下の結果がこうなりました。
タブを入れましたが、見やすいように、全角空白が入っています。

あああ AAA 0
""   BBB 1
いいい AAA 0
""   CCC  ""
""   ""  2
ううう DDD 1

Dim objFS
Set objFS=CreateObject("Scripting.FileSystemObject")
Set objText =objFS.CreateTextFile(myPath & "\result.txt")
ReDim testStr(3)
ReDim teststr2(3)
For i=1 To 3  '←念のために入れました。
teststr2(i)=""
Next
With Ts
j = 1
.MoveFirst
Do Until .EOF =True
For i = 1 To 3
testStr(i) = .Fields(i - 1).Value
If testStr(i) = teststr2(i) Then
testStr(i) = """""" ←空白の代わりにしました。
Else
teststr2(i) = testStr(i)
End If
Next
objText.WriteLine(Mid(Join(Teststr, vbTab),2))
.MoveNext
j = j + 1
Loop
objText.Close
MsgBox "finish!"
End With
    • good
    • 0
この回答へのお礼

遅くなってすみません。
ご回答ありがとうございました!

皆様のおかげで色々試しながらも、理想の動作に持って行くことができました!
本当に助かりました。

お礼日時:2017/03/28 20:12

#1の回答者です。


>補足日時:2017/03/21 18:29

ロジックは分かっていないけれども、(^^;、できていますね。失礼しました。
ただ、今、気になって、VBSに移植してみたけれども、以下のコードでくだんのエラーは出ませんでしたね。どこが違うのでしょうか?
Empty と比較するからいけないのでしょうか。Empty は型の変換が利かなかったように思います。もし、それが問題なら、最初に事前に、「""」を入れておけばよいと思います。一回やれば、後は、この変数は使い回しだから、型が違うということはないと思います。


ReDim testStr(3)
ReDim teststr2(3)

With Ts
.MoveFirst
Do Until .EOF =True
For i = 1 To 3
testStr(i) = .Fields(i - 1).Value
If testStr(i) = teststr2(i) Then
testStr(i) = ""
Else
teststr2(i) = testStr(i)
End If
Next
WriteLine Join(testStr, " ")  '出力は試していません。
.MoveNext
Loop
    • good
    • 0
この回答へのお礼

遅くなってすみません。
ご回答ありがとうございました!

皆様のおかげで色々試しながらも、理想の動作に持って行くことができました!
本当に助かりました。

お礼日時:2017/03/28 20:12

>3行目「testStr2(i) = tmpStr(i)」で比較した時に


>「型が一致していません」エラーが出ます。

強引に文字列型にしてから比較してはいかがですか。

if CStr(testStr2(i)) = CStr(tmpStr(i)) then
・・・・
    • good
    • 0
この回答へのお礼

回答ありがとうございます。
CStrを使う方法は試していなかったのでやってみます!
ありがとうございます!

お礼日時:2017/03/21 18:32

ややこしいですね。

(^^;
少しかんがえてみました。
本格的に、VBSに入れてはいないので、ミスが残っているかもしれません。

2次配列の変数にうつして処理しました。
エラーの原因はわかりませんが、もしかしたら変数は、同じものを利用しているのではないでしょうか。私なら、最初に適当に作っておいて、それで入れ出しします。
私のほうでは、ご希望どおりにはなりましたが、さて、
ReDim teststr(2, 200)
この最初の作り方にもよりますね。


ReDim teststr(2, 200)
i = 0: j = 0
With ts
.MoveFirst
Do
teststr(i, j) = .Fields(i)
i = i + 1
If i = .Fields.Count Then
.MoveNext
j = j + 1
i = 0
End If
Loop Until j >= .RecordCount
.Close
ReDim Preserve teststr(2, j - 1)
teststr2 = teststr
i = 0: j = 0
Base = teststr(j, i)
For j = 0 To UBound(teststr)
Do
i = i + 1
If Base = teststr(j, i) Then
teststr2(j, i) = ""
Else
Base = teststr(j, i)
End If
Loop Until i >= UBound(teststr, 2)
i = 0
Next
End With
    • good
    • 0
この回答へのお礼

回答ありがとうございます。
二次元配列を使う方法、とても参考になります!
試してみたいと思います!

お礼日時:2017/03/21 18:32

提示されたソースが良くわかりません。



不明箇所1)
3行目は
3: testStr2(i) = testStr(i)
のはずだが
3行目「testStr2(i) = tmpStr(i)」
となっている。
tmpStr(i)がいきなりでてくる。

不明箇所2)
3: testStr2(i) = testStr(i)
4: if testStr(i) = testStr2(i) then
3行目を実行した後、
4行目を実行すれば、常に等しいので、必ず、5行目が実行されるかと。

不明箇所3)
testStrとtestStr2の宣言箇所が不明なのでなんとも言えないが、
testStr(0)とtestStr2(0)は使用していないのか。
testStr(3)は、配列の範囲内に入っているのか。
この回答への補足あり
    • good
    • 0
この回答へのお礼

回答ありがとうございます。
直接打ったため、所々記載ミスしてしまいました。

不明箇所1)不明箇所2)
まず、下記3行目は不要でした。
3: testStr2(i) = testStr(i)
tmpStr(i)も打ち間違いで、testStr(i)です。

不明箇所3)
下記で宣言しています。
Dim testStr(3)
Dim testStr2(3)
回答ありがとうございます。
直接打ったため、所々記載ミスしてしまいました。

1: For i = 1 To 3
2: testStr(i) = ts.Fields(i-1).Value
3: if testStr(i) = testStr2(i) then
4: testStr(i) = ""
5: else
6: testStr2(i) = testStr(i)
7: end if
8: Next

お礼日時:2017/03/21 18:33

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aと関連する良く見られている質問

Qマクロで100マス計算! Dim i,j As Integer For i = 2 ToRang

マクロで100マス計算!

Dim i,j As Integer

For i = 2 ToRange(”A1”).End(xlDown).Row
For j=2 To Range(”B1”).End(xlToRight).Column

Cells(i,j).Value = Cells(i,1).Value * Cells(1,j).Value
Next j
Next i
Endsub

上記のように記述しましたが、
iの最終行が2となってしまっていますがなぜこのコードが間違っているのか分からないです。。どなたか教えていただけたら嬉しいです!

Aベストアンサー

確認してはいませんが…


>改行、スペースは実際にはきちんととっていますので気にしないでください
とのことなので、違っているのかもしれませんが、

>For i = 2 ToRange(”A1”).End(xlDown).Row
         ↓
 For i = 2 To Range(”A1”).End(xlDown).Row
で、うまくいきませんか?
100マス(10×10)と最初から決まっているので、範囲は 2 To 11 でも良いように思いますが…

改行、スペースなどが正しくなっているなら、Range(”A1”).End(xlDown).Rowの値が2以下になっている可能性が考えられます。(ということは、A1が空白セル、または、A3が空白セルなどなど・・)
A1が空白セルの場合は、
 For i = 2 To Range(”A2”).End(xlDown).Row
とするか、
 For i = 2 To 11
などとすることで、動作するのではないかと推測します。

Q【EXCEL VBA】Range("A:A").Find(What:="キーワード")の1行目について

自分なりに検索してみましたが、解決策を発見できませんでしたので質問させて下さい。

Sheet1・・・セルA1~A5の任意の場所に"5"を入力します。

標準モジュールに、以下のコードを記入しました。

Sub test()
Dim i As Integer
i = Sheets("Sheet1").Range("A:A").Find(What:="5").Row
MsgBox i
End Sub

見ての通り、A列全体から、1行目を起点に"5"を上から順に検索し、
最初に見つかった行ナンバーをメッセージボックスに表示するマクロです。

このマクロを実行した際、以下のようなことが起こりました。


"5"を入力するセル  /  MsgBoxが表示する行番号

(1) 1、2、3行目  /   2
(2) 1、3行目    /   3
(3) 1行目      /   1
(4) 3、4、5行目  /   3


このように、(3)「1行目のみに検索対象が存在する場合」及び
(4)「2行目以降に複数件、検索対象が存在する場合」には
最初に見つかったセルの行番号を正しく返してくれるのですが、

(1)(2)「1行目とそれ以外の行に検索対象が存在する場合」には、
「2行目以降」で最初に見つかったセルの行番号が返ってきます。

これはEXCEL VBAの仕様なのでしょうか?

社内で利用するために作成したツールの一部に上記コードを組み込んでおり、
想定した通りに動いてくれずに困っております。

やりたいことは、A列全体から指定のキーワードが存在するセルを検索し、
1行目も含めて、最初に見つかったセルの行番号を取得することです。

ご助言頂けますよう、よろしくお願いします。

自分なりに検索してみましたが、解決策を発見できませんでしたので質問させて下さい。

Sheet1・・・セルA1~A5の任意の場所に"5"を入力します。

標準モジュールに、以下のコードを記入しました。

Sub test()
Dim i As Integer
i = Sheets("Sheet1").Range("A:A").Find(What:="5").Row
MsgBox i
End Sub

見ての通り、A列全体から、1行目を起点に"5"を上から順に検索し、
最初に見つかった行ナンバーをメッセージボックスに表示するマクロです。

このマクロを実行した際、以下のようなことが起...続きを読む

Aベストアンサー

Sub test2()
'Dim i As Integer
Dim i As Long 'の方が宜しいかも
With Sheets("Sheet1")
i = .Range("A:A").Find(What:="5", After:=.Range("A" & Rows.Count)).Row
End With
MsgBox i
End Sub

After:= で検索開始する位置を指定します。
⇒実際には指定セルの次に見つかったセルですので、A列の最終行を指定しておくとこの場合A1を最初に見つけてくれます。

Qファイル内の(&H0A)を(&H0D0A)に変換したい

改行コードが0A(16進数)となってしまっているファイルを
0D0A(16進数)に変換したいのですが、どのような方法がありますか?
出来れば時間の掛からない方法が知りたいです。

ファイルは、ヤマト運輸の着店コードファイルで件数が3000件ほどあるのですが
改行コードが0AなのでInput#で読み込めません。

ファイルを変更しなくても良い方法があればそれでも結構です。

Aベストアンサー

置き換えてファイルの保存をしたかったのですね・・・

それと、やはり読み込まない事には、置き換えれないですよ。
だって読んでないんだもん・・・


んで、置き換えで保存するのに一番早いのは#2に書いてあるようにまず
「GETで読む」
「Replace関数で置き換える」← 一度でファイル内の文字列を変換できます(VB6仕様)
「PUTでファイルに落とす」
これをファイルの数だけ繰り返す処理になると思います。

大まかにわけると、たった3つの処理で済みます。

QACCESSのFieldの追加方法

VB初心者です。ACCESSのMDBに下記の構文でFieldの追加はできたのですが
少数点以下2桁に設定する方法がわからなく困っています。
Fieldプロパティにも無く、どなたか教えて下さい。

Set field01 = tdfEmployees01.CreateField("Tanka", dbCurrency)
tdfEmployees01.Fields.Append field01

Aベストアンサー

テキストボックスなどのコントロールに対してなら、Decimalplaces = 2 のようにプロパティを設定すればよいのですが、

DA0 で、テーブルの Field オブジェクトに設定する場合には、Properties コレクションに明示的に DisplayControl プロパティを追加してやらないと、VBAから参照できません。
(Access のHELPには、Field オブジェクトのプロパティとして載っていません。)

具体的には、

Dim dbs As Database
Dim tdfEmployees01 As DAO.TableDef, field01 As DAO.Field, prp As DAO.Property

Set dbs = CurrentDb
Set tdfEmployees01 = dbs.CreateTableDef("テーブル名")
Set field01 = tdfEmployees01.CreateField("Tanka", dbCurrency)

tdfEmployees01.Fields.Append field01
dbs.TableDefs.Append tdfEmployees01

Set prp = field01.CreateProperty("DecimalPlaces", dbByte, 2)
Call field01.Properties.Append(prp)

のようになります。
(CreateProperty は、テーブルの Append の後で実行してください。)

テキストボックスなどのコントロールに対してなら、Decimalplaces = 2 のようにプロパティを設定すればよいのですが、

DA0 で、テーブルの Field オブジェクトに設定する場合には、Properties コレクションに明示的に DisplayControl プロパティを追加してやらないと、VBAから参照できません。
(Access のHELPには、Field オブジェクトのプロパティとして載っていません。)

具体的には、

Dim dbs As Database
Dim tdfEmployees01 As DAO.TableDef, field01 As DAO.Field, prp As DAO.Propert...続きを読む

QVBAのプログラムについて:Excel2013より「実行事例外13・型の不一致」

以下のプログラムを使用していますが、プログラムの有効範囲をコピペして増やそうとすると、
「実行事例外13・型の不一致」というメッセージが出てしまいます。
記述に間違っている箇所はないと思うのですが、本件につきまして改善点をご教示いただけると幸いです。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
Const trg As String = "A1:ZZ1000"
Set Rng = Intersect(Target, Range(trg))
If Not Rng Is Nothing Then
Select Case Rng.Value

Case Is = "犬", "猫", "A"
Rng.Interior.ColorIndex = 7

Case Is = "淡水魚", "海水魚", "B"
Rng.Interior.ColorIndex = 44

Case Is = "牧草", "芝", "C"
Rng.Interior.ColorIndex = 8

Case Else 'その他の値なら色を消す
Rng.Interior.ColorIndex = xlNone
End Select
End If
End Sub

以下のプログラムを使用していますが、プログラムの有効範囲をコピペして増やそうとすると、
「実行事例外13・型の不一致」というメッセージが出てしまいます。
記述に間違っている箇所はないと思うのですが、本件につきまして改善点をご教示いただけると幸いです。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
Const trg As String = "A1:ZZ1000"
Set Rng = Intersect(Target, Range(trg))
If Not Rng Is Nothing Then
Select Case Rng.Value

Case...続きを読む

Aベストアンサー

コピーすると、Target のセルが複数(コピーした分)になります。
よって今回は1つのセルごとに対応しなくてはならないのでエラーになります。
※Select Case Rng.Valueの「Rng」が複数のセルなので値が取得できません。

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Rng   As Range
 Dim 複数Rng As Range

 Const trg As String = "A1:ZZ1000"
 Set 複数Rng = Intersect(Target, Range(trg))
 If 複数Rng Is Nothing Then Exit Sub

 For Each Rng In 複数Rng
  Select Case Rng.Value
   Case Is = "犬", "猫", "A"
    Rng.Interior.ColorIndex = 7
   Case Is = "淡水魚", "海水魚", "B"
    Rng.Interior.ColorIndex = 44
    Case Is = "牧草", "芝", "C"
    Rng.Interior.ColorIndex = 8
    Case Else 'その他の値なら色を消す
    Rng.Interior.ColorIndex = xlNone
  End Select
 Next
End Sub

コピーすると、Target のセルが複数(コピーした分)になります。
よって今回は1つのセルごとに対応しなくてはならないのでエラーになります。
※Select Case Rng.Valueの「Rng」が複数のセルなので値が取得できません。

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Rng   As Range
 Dim 複数Rng As Range

 Const trg As String = "A1:ZZ1000"
 Set 複数Rng = Intersect(Target, Range(trg))
 If 複数Rng Is Nothing Then Exit Sub

 For Each Rng In 複数Rng
  Select Case Rng.V...続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報