お世話になります。
下記のように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と関連する良く見られている質問

QEXCEL VBAでVLOOKUPを実行するとFALSEなのに、おかしな数字をもってきてしまいます。

EXCEL VBA 超初心者です。
以下のマクロを作成しました。VLOOKUPを使って、SHEET2にあるデータから、同じ№であるなら、SHEET1のE列に売上を持ってくるようにしたはずなのですが、一部うまく作動できずに困っています。
E17の黄色く塗りつぶした箇所ですが、SHEET2に№1523のデータがないので、0になるはずが、何故か№1515の値を持ってきてしまいます。
以下のマクロを実行した後、F列にVLOOKUPの関数を当ててみたところ、発覚しました。
E15やE22の緑の箇所は、データがないので、0になっているのでOKなのに、何故一部おかしい数値をもってくるのかわかりません。300くらいのデータの内、10件くらいは、おかしい数値をもってきてしまっており、結局VLOOKUPの関数を後から使って、データを修正するという手間になってしまっています。
マクロのどこがおかしいのでしょうか?
On Error Resume Nextの使い方が間違っていますか?
VLOOKUPでFALSEにしてあるのに訳が分からずおて上げ状態です。

わかりにくくて申し訳ありませんが、どなたか教えてください。
どうぞ宜しくお願い致します。

Sub 売上マクロ()

Dim i As Long
Dim Uriage As Long: Uriage = 0
Dim MyNum As Long
Dim MyData As Range

Set MyData = Worksheets(2).Range("A1").CurrentRegion

For i = 2 To Worksheets(1).Range("A1").End(xlDown).Row

MyNum = Worksheets(1).Cells(i, 3).Value

On Error Resume Next
Uriage = Application.WorksheetFunction.VLookup(MyNum, MyData, 3, False)
On Error GoTo 0
Worksheets(1).Cells(i, 5).Value = Uriage

Next i

End Sub

EXCEL VBA 超初心者です。
以下のマクロを作成しました。VLOOKUPを使って、SHEET2にあるデータから、同じ№であるなら、SHEET1のE列に売上を持ってくるようにしたはずなのですが、一部うまく作動できずに困っています。
E17の黄色く塗りつぶした箇所ですが、SHEET2に№1523のデータがないので、0になるはずが、何故か№1515の値を持ってきてしまいます。
以下のマクロを実行した後、F列にVLOOKUPの関数を当ててみたところ、発覚しました。
E15やE22の緑の箇所は、データがないので、0になっているのでOKなのに、...続きを読む

Aベストアンサー

本マクロでの状態ではVLOOKUPでエラー発生時(#N/Aのケース)で、そのまま続行しています。
そうすると、エラー発生時、Uriageにはなにもセットされない為、前回の値が残ります。
VLOOKUPの直前でUriageをクリアしてください。
----------------------------------
On Error Resume Next
Uriage = 0 '・・・①
Uriage = Application.WorksheetFunction.VLookup(MyNum, MyData, 3, False)
On Error GoTo 0
----------------------------------
①を追加してください。

Qマクロの「SaveAs」でエラーが出るのを解消したいです(再)

下記のエラーが出ます、似たようなもので新規ファイルで保存できたのですが
今回は出来ない状態になってしまいました。
ちょこちょこマクロ使うのですが、初心者で解決できません。
マクロ先生のご指導をお願いします。
※コピーされたシートが新ファイルで開かれた状態でエラー表示となります。


「実行時エラー '1004':

'SaveAs' メソッドは失敗しました: '_Worksheet' オブジェクト」


'指定額の抽出
Private Const MESSAGE_FINISH = "予算出力処理が完了しました"

Sub 予算データテキスト出力()
Dim ws1
Set ws1 = Worksheets("チェック一覧")
Dim m As Long
m = 3
Dim ws2
Set ws2 = Worksheets("予算データ")

Dim sm As String

Dim ws3

Dim sn

'チェック一覧シートのNo.が無くなるまで処理する
Do Until ws1.Cells(m, 1) = ""

Application.ScreenUpdating = False


If ws1.Cells(m, 4) = "" Then
'ナンバーがある場合は部門等をチェック一覧(ws1)→フォーム(ws2)に転記する
Else
ws2.Cells(2, 2) = ws1.Cells(m, 4)

'各部署のシート名をsmにセットする
sm = ws1.Cells(m, 2)
Set ws3 = Worksheets(sm)

'予算フォーム(ws2)の行変数「s」と各部署シート(ws3)の行変数「n」
Dim s
s = 4
Dim n
n = 9
Dim cnt
cnt = 1

Do Until n = 44
If ws3.Cells(n, 23) = 0 Then

'各数値等を各部署のシート(ws3)→フォーム(ws2)に転記する
Else

ws2.Cells(s, 1) = cnt
ws2.Cells(s, 3) = 6100
ws2.Cells(s, 4) = 0
ws2.Cells(s, 5) = ws3.Cells(3, 4)
ws2.Cells(s, 6) = ws3.Cells(5, 8)

ws2.Cells(s, 7) = ws3.Cells(n, 4)
ws2.Cells(s, 8) = ws3.Cells(n, 24)
ws2.Cells(s, 9) = ws3.Cells(n, 25)
ws2.Cells(s, 10) = ws3.Cells(n, 26)
ws2.Cells(s, 11) = ws3.Cells(n, 27)
ws2.Cells(s, 12) = ws3.Cells(n, 28)
ws2.Cells(s, 13) = ws3.Cells(n, 29)
ws2.Cells(s, 14) = ws3.Cells(n, 31)
ws2.Cells(s, 15) = ws3.Cells(n, 32)
ws2.Cells(s, 16) = ws3.Cells(n, 33)
ws2.Cells(s, 17) = ws3.Cells(n, 34)
ws2.Cells(s, 18) = ws3.Cells(n, 35)
ws2.Cells(s, 19) = ws3.Cells(n, 36)
s = s + 1
cnt = cnt + 1

End If

n = n + 1

Loop
'予算データに転記されたので出力する

ws2.Copy

' ↓↓↓↓↓この下の「SaveAs」がエラーになります。↓↓↓↓↓

ActiveWorkbook.SaveAs Filename:="D:\Library\Desktop\新しいフォルダー\" & ws2.Cells(s, 5).Value & ".txt", FileFormat:=xlText

ActiveWindow.Close

ActiveWorkbook.Close savechanges:=False


'フォームに転記した情報をクリア
ws2.Select
Range(Cells(4, 1), Cells(44, 19)).Select
Selection.ClearContents


End If

m = m + 1


Loop

ws1.Select

MsgBox MESSAGE_FINISH

End Sub

下記のエラーが出ます、似たようなもので新規ファイルで保存できたのですが
今回は出来ない状態になってしまいました。
ちょこちょこマクロ使うのですが、初心者で解決できません。
マクロ先生のご指導をお願いします。
※コピーされたシートが新ファイルで開かれた状態でエラー表示となります。


「実行時エラー '1004':

'SaveAs' メソッドは失敗しました: '_Worksheet' オブジェクト」


'指定額の抽出
Private Const MESSAGE_FINISH = "予算出力処理が完了しました"

Sub 予算データテキスト...続きを読む

Aベストアンサー

No1の方が指摘されているように、
ActiveWorkbook.SaveAs Filename:="D:\Library\Desktop\新しいフォルダー\" & ws2.Cells(s, 5).Value & ".txt", FileFormat:=xlText
のときの、 ws2.Cells(s, 5).Valueの値が不正な可能性があります。

この行の直前で、
msgbox("<" & ws2.Cells(s, 5).Value & ">")
を行い、ws2.Cells(s, 5).Valueの内容を確認しては、いかがでしょうか。

QエクセルVBA 文字列の分解について

こんばんは
変数 shetに「2007年2月」という文字列がはいっております。
これをそれぞれ2007と2に分けるため、いかのようにいたしました。
もうすこしスマートに記載する方法はございませんでしょうか。
(変数や配列などをこのために2つ使っており非常に見にくいと思っているため)

tmps = Split(shet, "年")
qw = tmps(0)
qw1 = tmps(1)
tmps1 = Split(qw1, "月")
qr = tmps1(0)

以上 宜しくおねがいいたします。

Aベストアンサー

二種類のマクロを提示します。Basp21 というのは、フリーのPerl ライクの正規表現オブジェクトです。VBAは、Lispのような言語ではないので、それなりの書き方に決まってきてしまいます。

Sub TextConvert()
 Dim text_date As String
 Dim bufDate As Variant
 Dim y As Integer, m As Integer
 text_date = "2007年2月"
 bufDate = DateValue(text_date)
 y = Year(bufDate)
 m = Month(bufDate)
End Sub

'Basp21の利用で、配列に入れる場合
Sub Basp21Test()
'配列に入れるなら、PerlライクのBasp21で切り分けます
 Dim text_date As String
 Dim bufDate As Variant
 Dim y As Integer, m As Integer
 Dim ar
 Dim bobj As Object
 Set bobj = CreateObject("Basp21")
 text_date = "2007年2月"
 ar = bobj.Split("/[年月]/kg", text_date)
 y = ar(0)
 m = ar(1)
End Sub

二種類のマクロを提示します。Basp21 というのは、フリーのPerl ライクの正規表現オブジェクトです。VBAは、Lispのような言語ではないので、それなりの書き方に決まってきてしまいます。

Sub TextConvert()
 Dim text_date As String
 Dim bufDate As Variant
 Dim y As Integer, m As Integer
 text_date = "2007年2月"
 bufDate = DateValue(text_date)
 y = Year(bufDate)
 m = Month(bufDate)
End Sub

'Basp21の利用で、配列に入れる場合
Sub Basp21Test()
'配列に入れるなら、PerlライクのBasp21で...続きを読む

Qvbsでは漢字の変数は使えないのでしょうか。

下記はエラーになります。
Option Explicit
Dim 氏名

氏名=InputBox("氏名を入力して下さい")
MsgBox(氏名)

ここで、氏名をnameに変更すると正しく実行します。
Option Explicit
Dim name

name=InputBox("氏名を入力して下さい")
MsgBox(name)

漢字の変数を使う方法は無いのでしょうか。

Aベストアンサー

もうお答えは出ているようですが、私からも回答します。

2byte 文字を変数にすると、

\kanjitest.vbs(2, 5)
「Microsoft VBScript コンパイル エラー: 文字が正しくありません。」

のエラーが出ます。
Unicode VBSにしても、やはりエラーが出ます。

もともと、String 型で認められる所以外では、2byte 文字は、ハングしますから、仕方がありません。VBAとは違いますから。
これを、HTA にして、Charset を、UTF-8 にしても、エラーは出ます。諦めることでしょうね。

Qエクセル vba プロシージャ 1981

Private Sub Worksheet_Change(ByVal Target As Range)
Worksheet_Change_1 Target '1つ目のWorksheet_Change処理
Worksheet_Change_2 Target '2つ目のWorksheet_Change処理
End Sub

For a = 3 To 10
If Cells(a, 22).Value <> "" And Right(Cells(a, 22).Value, 2) <> " 様" Then Cells(a, 22).Value = Cells(a, 22) & " 様"
Next

If Cells(5, 14) = "山田太郎 様" Then '
With Cells(5, 14).Characters(Start:=3, Length:=2).Font
.Size = 1
.ColorIndex = 2
End With
End If

Private Sub Worksheet_Change(ByVal Target As Range)
For a = 1 To 7
For b = 8 To 14
If Cells(a, 7) <> "" Then Range(Cells(a * 10 - 9, 1), Cells(a * 10, 3)).BorderAround Weight:=xlHairline
If Cells(b, 7) <> "" Then Range(Cells(b * 10 - 79, 4), Cells(b * 10 - 70, 6)).BorderAround Weight:=xlHairline
Next
Next
End Sub

このプロシージャは何を意味しますか?

Private Sub Worksheet_Change(ByVal Target As Range)
Worksheet_Change_1 Target '1つ目のWorksheet_Change処理
Worksheet_Change_2 Target '2つ目のWorksheet_Change処理
End Sub

For a = 3 To 10
If Cells(a, 22).Value <> "" And Right(Cells(a, 22).Value, 2) <> " 様" Then Cells(a, 22).Value = Cells(a, 22) & " 様"
Next

If Cells(5, 14) = "山田太郎 様" Then '
With Cells(5, 14).Characters(Start:=3, Length:=2).Font
.Size = 1
.ColorIndex = 2
End With
End If

Private Sub Wo...続きを読む

Aベストアンサー

①と③はどこかのシートモジュールに書かれたコードかと思いますが、②は「Sub ~」や「Function ~」が無いので意味を成さないかと思います。
またどこかに「Function Worksheet_Change_1(○○ As Range)」などのユーザー定義関数が有ると思いますのでそちらが無いとまったくわかりません。

Q【EXCEL】別のワークブックにアクティブシートをコピーして挿入したい

別のワークブックにアクティブシートをコピーして挿入したいと思っております。
挿入先に同じ名前のワークシートが存在する時はシートを挿入しない、
という場合は自力で実現できました。

ところが、頑張ってみたのですがシートが存在した場合に上書きする方法がわかりません。
※既存のシートを削除して新規のシートを挿入する

すいませんが詳しい方、説明の上手な方、直接、コードで説明できる方、
お手数ですが教えて下さい。よろしくお願いします。


詳細~シートの挿入時に必要な機能、etc.

1)挿入先に同じ名前のシートがある場合、既存のシートを削除して新規のシートを挿入
2)挿入先のワークブックが開いている場合
※「開いていているための挿入出来ない」のエラーメッセージの表示

3)ユーザーフォームのボタンから実行します。
動作が分割される場合はボタン一発で実行できるものでお願いします。
→Callの利用は無理だと思います。
4)挿入前にシート名に「No」の記載がされているか
「はい」、「いいえ」を確認するメッセージを入れたい。
※マクロで「No」を追加するのはなしです。
今後も社内ルールの確認用のメッセージに使う予定ですので。

5)A列とH列に全角文字があれば半角に変換に変換したシートを挿入する
6)便宜上、ワークブックの名前、フォルダーは以下の通りでお願いします
ワークブックの名前
コピー元:コピー元.xlsm
コピー先:挿入先.xlsm
「挿入先.xlsm」のフォルダーはCドライブの
「A」フォルダーの中ということでお願いします。

追記
こちらも参考にトライしてみました、ご参考にどうぞ

https://oshiete.goo.ne.jp/qa/9476111.html

※文字数がオーバーするので、前述の
「挿入先に同じ名前のワークシートが存在する時は、シートを挿入しない場合」
のコードは記載しませんでした。

必要でしたら別途質問を立てて、そちらに貼り付けますので、
お気軽にリクエストしてください。

すいませんがよろしくお願いします。

別のワークブックにアクティブシートをコピーして挿入したいと思っております。
挿入先に同じ名前のワークシートが存在する時はシートを挿入しない、
という場合は自力で実現できました。

ところが、頑張ってみたのですがシートが存在した場合に上書きする方法がわかりません。
※既存のシートを削除して新規のシートを挿入する

すいませんが詳しい方、説明の上手な方、直接、コードで説明できる方、
お手数ですが教えて下さい。よろしくお願いします。


詳細~シートの挿入時に必要な機能、etc.

...続きを読む

Aベストアンサー

No1です。
既にNo2の方が回答されてますので、参考までに。コマンドボタン1をクリックした想定です。
--------------------------------------
Option Explicit

Private Sub CommandButton1_Click()
Const FolderName As String = "c:\A"
Const TrgBookName As String = "挿入先.xlsm"
Dim trgBook As Workbook
Dim srcBookName As String
Dim srcSheetName As String
Dim srcBook As Workbook
Dim wBook As Workbook
Dim wSheet As Worksheet
Set srcBook = Application.ActiveWorkbook
srcBookName = Application.ActiveWorkbook.Name
srcSheetName = ActiveSheet.Name
If MsgBox("シート名は[" & srcSheetName & "]です。" & vbLf & "シート名にNoが記載されていますか?", vbYesNo) <> vbYes Then
Exit Sub
End If
Call ZenToHan("A") 'A列を全角から半角変換
Call ZenToHan("H") 'H列を全角から半角変換
'挿入先のBookが開いているかチェックする
For Each wBook In Workbooks
If UCase(wBook.Name) = UCase(TrgBookName) Then
MsgBox (TrgBookName & "は既に開いています。閉じて下さい。")
Exit Sub
End If
Next
'挿入先のBookが存在するかチェックする
If Dir(FolderName & "\" & TrgBookName) = "" Then
MsgBox (FolderName & "\" & TrgBookName & "が存在しません。")
Exit Sub
End If
'Bookオープン
Set trgBook = Workbooks.Open(Filename:=FolderName & "\" & TrgBookName)
If trgBook.ReadOnly = True Then
trgBook.Close
MsgBox (TrgBookName & "は既に使用されています。")
Exit Sub
End If
'挿入先に該当シートが存在すれば削除する
For Each wSheet In Worksheets
If UCase(wSheet.Name) = UCase(srcSheetName) Then
Application.DisplayAlerts = False
Worksheets(wSheet.Name).Delete
Application.DisplayAlerts = True
Exit For
End If
Next
'シートコピー
Workbooks(srcBookName).Worksheets(srcSheetName).Copy after:=Worksheets(Worksheets.Count)
'Bookクローズ
ActiveWorkbook.Save
ActiveWorkbook.Close
'元のBook,Shhetをアクティブに設定
Workbooks(srcBookName).Activate
Worksheets(srcSheetName).Activate
MsgBox (srcSheetName & "のコピー完了")
End Sub
'全角から半角へ変換する
Private Sub ZenToHan(ByVal col As String)
Dim row, maxrow As Long
maxrow = Cells(Rows.Count, col).End(xlUp).row '最終行を求める
For row = 6 To maxrow
Cells(row, col).Value = StrConv(Cells(row, col).Value, vbNarrow)
Next
End Sub
----------------------------

No1です。
既にNo2の方が回答されてますので、参考までに。コマンドボタン1をクリックした想定です。
--------------------------------------
Option Explicit

Private Sub CommandButton1_Click()
Const FolderName As String = "c:\A"
Const TrgBookName As String = "挿入先.xlsm"
Dim trgBook As Workbook
Dim srcBookName As String
Dim srcSheetName As String
Dim srcBook As Workbook
Dim wBook As Workbook
Dim wSheet As Worksheet
Set srcBook = Application.A...続きを読む

QVBA 再帰について

こんばんは
再帰についておしえてください。
実行結果は120となります。
F8で動作を追っていくと
Sample_subに5を渡してn<=1になるとENDIFにうつり
その後、END funtionとEndifの間をいききしております。
どうして、こういう動作をするのでしょうか?
よろしくおねがいいたします。

Sub sample()
MsgBox sample_sub(5)
End Sub
Function sample_sub(ByVal n As Integer)
If n <= 1 Then
sample_sub = 1 'ここで再帰処理は終了します。
Else
sample_sub = n * sample_sub(n - 1) 'ここで自分自身を呼び出しています。
End If
End Function

Aベストアンサー

VBA の
Function名 = 戻り値
って書き方に惑わされていませんか?
> sample_sub(5)
で呼び出したときの sample_sub=〜 と、その中の
> sample_sub = n * sample_sub(n - 1) 'ここで自分自身を呼び出しています。
にある sample_sub(n - 1) で呼び出されたときの sample_sub=〜 とは、別なものになります。
「一つの変数sample_sub」 の値が変化しているわけではありません。
ステップ実行で見ると、プログラムの同じ行を指しているので「一つの変数sample_sub」 の値が変化している」様に見えてしまいますが、そうではないのです。


別の例を用意します。
sample_sub(5) で呼び出したのと、同じ動きをする関数 sample_sub_5 を作ります。

Function sample_sub_5()
If 5 <= 1 Then
sample_sub_5 = 1
Else
sample_sub_5 = 5 * sample_sub_4()
End If
End Function

同様に4〜1を用意します

Function sample_sub_4()
If 4 <= 1 Then
sample_sub_4 = 1
Else
sample_sub_4 = 4 * sample_sub_3()
End If
End Function

Function sample_sub_3()
If 3 <= 1 Then
sample_sub_3 = 1
Else
sample_sub_3 = 3 * sample_sub_2()
End If
End Function

Function sample_sub_2()
If 2 <= 1 Then
sample_sub_2 = 1
Else
sample_sub_2 = 2 * sample_sub_1()
End If
End Function

Function sample_sub_1()
If 1 <= 1 Then
sample_sub_1 = 1
Else
sample_sub_1 = 1 * sample_sub_0()
End If
End Function


この sample_sub_5() での動作は、 sample_sub(5) とまったく同じになります。

VBA の
Function名 = 戻り値
って書き方に惑わされていませんか?
> sample_sub(5)
で呼び出したときの sample_sub=〜 と、その中の
> sample_sub = n * sample_sub(n - 1) 'ここで自分自身を呼び出しています。
にある sample_sub(n - 1) で呼び出されたときの sample_sub=〜 とは、別なものになります。
「一つの変数sample_sub」 の値が変化しているわけではありません。
ステップ実行で見ると、プログラムの同じ行を指しているので「一つの変数sample_sub」 の値が変化している」様に見えてしまいますが、そ...続きを読む

Qエクセルのバージョンアップによるマクロ不調

エクセル2007にて、for...next構文を含むマクロをフォームボタンに登録し使用していました。
カウンタ変数に3から25を代入しています。
(3行目から25行目を処理するため)

しかしエクセル2016にパソコンが変わり、ボタンを押すと3行目だけ処理しマクロが終わってしまいます。
ボタンを押す代わりに、VBEから直接実行すると問題なく最後まで繰り返し処理されます。

バージョンアップにより何か不都合があるのでしょうか。お教え下さい。

Aベストアンサー

#2の回答者です。
長文でまとまっていませんが、私の考えたレポートです。

こちらは、Excel 2013ですが、一応、通して動かしてみて完結はするのですが、途中、何か良くわからない動きがあります。このコードには、どちらかというと「気になる」の部分はあります。しかし、それ以上に、ハングしたかなって思わせるような状態で、マクロが終了しているのです。それが何か今のところは分かりません。
どうも、ステップで進める分には、まったくその問題はみられません。

そのコードで問題になる部分は、2つですが、結論からすると、直しても変わりませんでした。
> Dim h As Integer 'データ集積シートの最終行
これは、Integer ではなくて、Long 型のほうがよいです。
ついでに、Dim i As Long '入力表シートの行数 もLong型のほうがよいのは、PCの扱うデータは、32bit が主なので、Integer 型は、一旦、Long型に変換しているので、なるべく、Integer 型は使わないほうがよいとしています。

>h = Worksheets("集積_税制").Range("A65536").End(xlUp).Row + 1
これは、最初、ループの外で行って、書き込みが完了したら、
h = h+1

とします。ただ、それでも、問題はほとんど改善されませんでした。
ふつうは、マクロが抜けるという現象からしても、私の試した感じでは、どうやらメモリリークの現象に似ています。アンタッチャブルな部分に触れると、マクロは急停止してしまいます。

なお、Select Case  [値]  ←ここの値は、文字列でも数値でも構わないです。ただ、コードを見る限りは、数値になっているようですので、それ自体は問題なかろうと思います。

ボタンは、フォームオブジェクトのボタンをお使いになっているものだとは思いますが、ActiveX ですと、そのコードですと、少し問題が出る可能性はあります。

それで、私なりの書き方でコードを書いてみましたので、そちらで診ていただけませんか?

'// 基本的には、標準モジュールです。
Sub Integrated_Taxes()
 Dim i As Long '入力表シートの行数
 Dim h As Long 'データ集積シートの最終行
 Dim j As Long '新しく加えた変数
 Dim acSh As Worksheet '現在の表
 Dim iTaxSh As Worksheet
 '***設定****
 Set acSh = ActiveSheet 'このシートは「入力表_税制」か?
 Set iTaxSh = Worksheets("集積_税制")
 
 Application.ScreenUpdating = False
 h = iTaxSh.Cells(Rows.Count, 1).End(xlUp).Row + 1
 With acSh
  For i = 3 To 25 '入力表の入力可能行数
   If .Cells(i, 3).Value > 0 And .Cells(i, 3).Value < 4 Then
    j = .Cells(i, 3).Value + 3
    iTaxSh.Cells(h, 1).Resize(, 3).Value = .Cells(i, 7).Resize(, 3).Value
    iTaxSh.Cells(h, j).Value = .Cells(i, 10).Value
    h = h + 1
   End If
  Next i
 
 End With
 Application.ScreenUpdating = True
 
 iTaxSh.Select
 MsgBox "取り込みが終了しました!"
 Worksheets("入力表_税制").Select
 Range("B1").Select

End Sub
'//

以上です。

#2の回答者です。
長文でまとまっていませんが、私の考えたレポートです。

こちらは、Excel 2013ですが、一応、通して動かしてみて完結はするのですが、途中、何か良くわからない動きがあります。このコードには、どちらかというと「気になる」の部分はあります。しかし、それ以上に、ハングしたかなって思わせるような状態で、マクロが終了しているのです。それが何か今のところは分かりません。
どうも、ステップで進める分には、まったくその問題はみられません。

そのコードで問題になる部分は、2つですが...続きを読む

QComboboxについて

Microsoft Visual Basic 2010 Expressでtxtfileを読み込み、そのデータをComboboxに追加するにはどのようにすれば宜しいのでしょうか。

Aベストアンサー

ココにはその手の専門家がおられますが、処理内容が多すぎて、まだ参加されていない様ですね。
私が作ると仮定して、思いつくままに操作を簡単に書きますと
>Microsoft Visual Basic 2010 Expressでtxtfileを読み込み
どこの、なんという?←ファイルの指定方法の選択

>そのデータを
個別データはどうやって分ける?
ご存知のようにTextファイルの内容は、ある意味単純すぎて個別データへの変換が複雑です。

1.単なる改行で区切られた1行毎のデータ
2.”や,/のような区切り文字(特定のコードで判別可能な場合)
その他空白(スペース)区切りなんてのもアリです。

>Comboboxに追加する
この程度であれば私でも回答可能なので書いておきますが
[Combobox].AddItem
AddItem メソッドで可能です。
[Combobox]:追加したいComboboxオブジェクトを示しています。
VB6用ですが、参考のために
http://cya.sakura.ne.jp/vb/ComboBox.htm

ただし、この追加を
いつ?(どのタイミングで)
毎回やるの?
新規?または追加?
などの条件が必要です。

もし質問者さんが本気で作りたいのであれば、

Item1
Irem2
のような改行された・・・
※追加したいTextファイルの形式を明確に示し
また、特別な区切り文字等を使用している場合は大問題です。そのデータを分離するコードを書くだけで1つの質問になりますよ!

等の質問をされた方が回答しやすいと思います。

その他のアドバイス
データ用のtextファイルの位置及びファイル名は固定しておいた方が楽です。
「毎回別ファイルを指定する」ような場合は、これまた一苦労です。
これくらいは既にありそうです。
ここで「テキストファイル」で検索するだけでこれだけ出てきますよ。
https://oshiete.goo.ne.jp/search_goo/result/?MT=%E3%83%86%E3%82%AD%E3%82%B9%E3%83%88%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB&code=utf8&from=pc_suggest_top

ココにはその手の専門家がおられますが、処理内容が多すぎて、まだ参加されていない様ですね。
私が作ると仮定して、思いつくままに操作を簡単に書きますと
>Microsoft Visual Basic 2010 Expressでtxtfileを読み込み
どこの、なんという?←ファイルの指定方法の選択

>そのデータを
個別データはどうやって分ける?
ご存知のようにTextファイルの内容は、ある意味単純すぎて個別データへの変換が複雑です。

1.単なる改行で区切られた1行毎のデータ
2.”や,/のような区切り文字(特定のコードで判別可能...続きを読む

Qユーザ定義型は定義されてません

こんばんは
実行すると「ユーザ定義型は定義されてません」と表示されます。
どなたかわかる方おしえてください。
Sub m()
Dim a As New NotesSession
・・・

End Sub

Aベストアンサー

参考になるかな?

セッションオブジェクトを作成する
https://www.ibm.com/support/knowledgecenter/ja/SSVRGU_8.5.3/com.ibm.designer.domino.main.doc/H_ACCESSING_THE_DOMINO_OBJECTS_THROUGH_COM_CREATING.html


人気Q&Aランキング

おすすめ情報