VBAで行数を数えてテキストデータにコピーしたい。

質問

エクセルの実行ボタンを押すとアクティブシートにあるデータのA7から空白までの行数を数えて、その行数と同じ分、テキストデータをSQLテキストファイルにコピーしたいのですが、うまくいきません。
どなたか分かる方教えてください。
出来れば、下記のVBAを生かして組み込みたいです。
よろしくお願いします。

Private Sub CommandButton1_Click()

Dim myDate As String
Dim myPath As String
Dim NewPath As String
Dim FNo As Integer
Dim Ar(1) As String
Dim SqlData As String
Dim i As Integer
Dim j As Integer

'★配列にsqlファイルのタイトルを代入★
Ar(0) = "TEST1.sql"
Ar(1) = "TEST2.Sql"

'★sqlデータの内容を入れる★

sqlData0 = ActiveSheet.Rows("A7:")(xlDown) * "testdata_a" & Chr(13) & Chr(10)
SqlData1 = ActiveSheet.Rows("A7:")(xlDown) * "testdata_b" & Chr(13) & Chr(10) & "testdata_c"

myDate = Format(Date, "yyyymmdd")
myPath = ThisWorkbook.Path
NewPath = myPath & "\" & myDate
↑VBAは省略して途中まで記載しました。

回答No.2

Wendy02 · ベストアンサー

こんにちは。Wendy02です。

>エクセルの実行ボタンを押すと
>アクティブシートにあるデータのA7から空白までの行数を数えて、その行数と同じ分、
>テキストデータをSQLテキストファイルにコピーしたい

元のご質問のURLは出しておいたほうが良いかなって思います。書いた本人(私)が、常に、フィードバックできるとは限りませんので。

>sqlData0 = ActiveSheet.Rows("A7:")(xlDown) * "testdata_a" & Chr(13) & Chr(10)

コマンドボタンで、ActiveSheet ということもないなって思いますね。ボタンを押してからシートを選択するなら別ですが。

#1 さんの「具体的にこういう結果になって欲しいのだが、結果はこうなるみたいなモノがあるならそちらをあげられた方がよいかと。」それは、同感です。

今回は、結果が見えていないので、はっきりしたことは言えませんが、
SqlData1 側は、　"testdata_b" & Chr(13) & Chr(10) & "testdata_c"
とすると、

testdata_b
testdata_ctestdata_b
testdata_ctestdata_b
　・
　・
　・
ということになるので、全体のバランスとしてなんとなく変なので、その後に改行コードを入れました。

'--------------------------------------------------------

Sub MakeFolderDateR()
　Dim myDate As String
　Dim myPath As String
　Dim NewPath As String
　Dim FNo As Integer
　Dim Ar(1) As String
　Dim i As Integer
　'新たに加えた

　Dim SqlData(1) As String　'配列
　Dim cnt As Integer　'A7 以降の数を数える
　Dim j As Integer
　Dim buf As String

　'配列に入れる
　Ar(0) = "test1.sql"
　Ar(1) = "test2.sql"
　'データ
　SqlData(0) = "testdata_a" & Chr(13) & Chr(10)
　SqlData(1) = "testdata_b" & Chr(13) & Chr(10) & "testdata_c" & Chr(13) & Chr(10)
　'※SqlData(1)側は修正を加えました。

　'アクティブシートにあるデータのA7から空白までの行数を数えて、その行数と同じ分、
　With ActiveSheet　'←コマンドボタンの場合はActiveSheetは必要ないはず

　　cnt = .Range("A7", .Range("A7").End(xlDown)).Rows.Count
　End With
　If cnt = 0 Then MsgBox "ワークシートを確認してください。", vbInformation: Exit Sub
　For i = 0 To UBound(SqlData())
　　For j = 1 To cnt
　　　buf = buf & SqlData(i)
　　Next j
　　SqlData(i) = Mid$(buf, 1, Len(buf) - 2)
　　'ファイルの最後の改行コードは、削除しておきます。
　　buf = ""
　Next i

　myDate = Format(Date, "yyyymmdd")
　myPath = ThisWorkbook.Path

　NewPath = myPath & "\" & myDate
　'パスの有無を調べる
　If Dir(NewPath, 16) = "" Then 'vbDirectory
　　MkDir NewPath
　End If
　For i = 0 To UBound(Ar)
　　FNo = FreeFile()
　　Open NewPath & "\" & Ar(i) For Output As #FNo
　　Print #FNo, SqlData(i) '出力も配列
　　Close #FNo
　Next i
End Sub

'----------------------------------------------------

補足

Wendy02さん、回答どうもありがとうございました！
また、急な予定が入ってしまい、質問したにも関わらず書き込みが遅くなって申し訳ありませんでした。

＞元のご質問のURLは出しておいたほうが良いかなって思います。
すみません。確かにこれでは今回の質問を読んだだけでは意味が分からないと思います。

実は、この作業の後に更に置き換えもしたいのですが、少しずつ教えていただいて自分で勉強しつつ置き換えをやってみよう、と質問を小出しにしてしまいました。
これでは何度も回答していただく事になりますし、どうしたいのかも伝わりにくかったと思います。
なので、この質問は一度解決にして、新たに質問を整理して投稿したいと思います。
丁寧に回答していただいたお二方にはご迷惑をおかけして申し訳ありませんでした。
もし宜しければまた是非回答をよろしくお願いいたします。

回答No.1

popesyu

>その行数と同じ分、テキストデータをSQLテキストファイルにコピー
ここの処理が分かりません。
縦に並んでいるセルの内容をただ横につなげるだけななのでしょうか？SQL文にしたいのなら、例えば
SELECT A7,A8,A9...
というような感じに繋げたいとかじゃないんですかね？
それともエクセルの内容をそのままtxtにコピーしたのと同じ結果にしたいのか。
A7
A8
A9
...
と1行ずつ改行が入る形式。

あとこちらも何をしようとしているのか。どんな値を取ることを期待しているのでしょう。
>sqlData0 = ActiveSheet.Rows("A7:")(xlDown) * "testdata_a" & Chr(13) & Chr(10)
ActiveSheet.Rows("A7:")(xlDown)　意味が通じないのでこの時点でエラーが出ませんか？　その後の文字列との連結（"testdata_a"）も改行が入る部分（Chr(13)やChr(10)）も意味不明ですけど。
特定の行以下からから次の空白行までの行数を取得するならこういう感じになりますが。
ActiveSheet.Range("A7").End(xlDown).Row

>うまくいきません。
というのはどううまくいかないのでしょう。txtへの保存ができないのか、保存した結果が期待したものにならないのか、具体的にこういう結果になって欲しいのだが、結果はこうなるみたいなモノがあるならそちらをあげられた方がよいかと。
どうされたいのかと、どこが間違っているのかも分からないし（にもかかわらず基本的なところはここを使いたいとの要望があるし）、またその要望の部分はtxtファイルの保存名と保存場所を決めている部分のようで幾らでも修正できる部分にしか思えないのですが。

補足

回答どうもありがとうございます！
また、急な予定が入ってしまい、質問したにも関わらず書き込みが遅くなって申し訳ありませんでした。
質問が分かりにくく、詳細も書いていなかったので回答していただく方にご迷惑をかけてしまいました。
改めて質問を整理して出直しますのでまたよろしくお願いいたします。