Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


3600 / 13644 ツリー ←次へ | 前へ→

【61213】外部データ読み込みVB 紅ほっぺ 09/4/16(木) 14:16 質問[未読]
【61216】Re:外部データ読み込みVB つん 09/4/16(木) 15:09 回答[未読]
【61217】Re:外部データ読み込みVB 紅ほっぺ 09/4/16(木) 15:26 質問[未読]
【61218】Re:外部データ読み込みVB つん 09/4/16(木) 15:35 回答[未読]
【61220】Re:外部データ読み込みVB neptune 09/4/16(木) 15:43 発言[未読]
【61228】つんさん、neptuneさん、ありがとうござい... 紅ほっぺ 09/4/17(金) 15:14 お礼[未読]

【61213】外部データ読み込みVB
質問  紅ほっぺ  - 09/4/16(木) 14:16 -

引用なし
パスワード
   いつもありがたく勉強させてもらっています。m(_ _)m

特定のフォルダ"file_A"に入っている全てのエクセルファイルの、特定のシートにあるデータをVBで抜き出そうと思っています。

file_Aフォルダには、A.xls,B.xls,C.xls,...と複数のエクセルファイルが入っていますが、全て同フォーマットで作られています。
それぞれに「シート」という名前のsheetがあり、A1セル〜G14にわたってテキストデータが存在します。
そのテキストデータを自動的にVB実行元のファイル内のsheet"抽出"のA1行から順に並べたいと思っています。

イメージとしてはこうです。
A.xlsの"シート"sheet:
A A A A A A A
A A A A A A A
A A A A A A A

B.xlsの"シート"sheet:
B B B B B B B
B B B B B B B
B B B B B B B

C.xlsの"シート"sheet:
C C C C C C C
C C C C C C C
C C C C C C C


VB実行後の"抽出"sheet(VB実行元ファイル):

A A A A A A A
A A A A A A A
A A A A A A A
B B B B B B B
B B B B B B B
B B B B B B B
C C C C C C C
C C C C C C C
C C C C C C C

このように抽出して並べたいと思っています。


そこで、

Sub vbsample()

Application.ScreenUpdating = False
Dim MyPath As String
Dim MyName As String
Dim OpenFileName As String
Dim zentai As Variant
Dim gyo As Integer
Dim retsu As Integer
Dim wb As Workbook '参照元ファイル用
Dim skb As Workbook 'データ抽出ファイル用
 
gyo = 1 'データを貼り付ける先頭行
Set skb = ActiveWorkbook

MyPath = "C:\Documents and Settings\Administrator\デスクトップ\file_A" 'xlsが入っているフォルダ名を指定
MyName = Dir(MyPath & "\*.xls") '.xlsがつく全てのファイルを対象とする
 
Do While MyName <> "" '全てのファイルを参照するまでLoop処理
OpenFileName = MyPath & "\" & MyName '現在の参照元のエクセルファイルへのパス
Workbooks.Open (OpenFileName)

Set wb = ActiveWorkbook
zentai = Worksheets("シート").Range("A1:G14").FormulaR1C1 '抽出したいデータを含むセルの範囲を指定
    
retsu = 1 'データを貼り付ける先頭列
   
For Each zentai In Worksheets("シート").Range("A1:G14")
skb.Worksheets("抽出").Cells(gyo, retsu) = zentai
retsu = retsu + 1
Next

gyo = gyo + 1 'ファイルが変わると行を下げる
MyName = Dir '参照元ファイルをnullに
wb.Close (False) '保存なしで閉じる
Loop '処理を繰り返す
Sheets("抽出").Select

End Sub

との式を使用しているのですが、結果が下記のようになってしまいます。
(一つのファイルから嫡出したデータが横並びになってしまう)

A A A A A A A A A A A A A A A A A A A A A
B B B B B B B B B B B B B B B B B B B B B
C C C C C C C C C C C C C C C C C C C C C

どのように設定すれば

A A A A A A A
A A A A A A A
A A A A A A A
B B B B B B B
B B B B B B B
B B B B B B B
C C C C C C C
C C C C C C C
C C C C C C C

になるのでしょうか?

大変お手数ですが、ご教授よろしくお願いいたします。m(_ _)m

【61216】Re:外部データ読み込みVB
回答  つん  - 09/4/16(木) 15:09 -

引用なし
パスワード
   ▼紅ほっぺ さん
こんにちは^^

>For Each zentai In Worksheets("シート").Range("A1:G14")
>skb.Worksheets("抽出").Cells(gyo, retsu) = zentai
>retsu = retsu + 1
>Next

ここで、retsuの値ばかり足していってるから、
横方向に一列に転記されていってるんじゃないですか?

A1からG1に行ったら、次は行方向…gyoを増やしてあげないと・・・

【61217】Re:外部データ読み込みVB
質問  紅ほっぺ  - 09/4/16(木) 15:26 -

引用なし
パスワード
   ▼つん さん:
>▼紅ほっぺ さん
>こん▼つん さん:
レスありがとうございます!

>>For Each zentai In Worksheets("シート").Range("A1:G14")

ここでデータを抽出する際に、

A A A A A A A
A A A A A A A
A A A A A A A

だったものが

A A A A A A A A A A A A A A A A A A A A A

として抽出されていることは分かったのですが、
A1からA2,A3と行の数が増えていくに従って、抽出先のシートでも行を増やして反映したい場合、VBをどう書けばいいのか思いつきません。。><
ファイルが変わった次点で行を増やすまでは出来たのですが。。

初心者過ぎて、なにやらやりたいことに対してとんちんかんなことをしている気もしますが、よろしくお願いします。m(_ _;)m

【61218】Re:外部データ読み込みVB
回答  つん  - 09/4/16(木) 15:35 -

引用なし
パスワード
   えーっとですね

>For Each zentai In Worksheets("シート").Range("A1:G14")
>skb.Worksheets("抽出").Cells(gyo, retsu) = zentai
>retsu = retsu + 1
>Nex

A1:G14
ってことは、横7×縦14なので、「retsu」が7になった時点で、
gyoを1増やして、retsuを再び1に戻せばいいんじゃないかな?

ちょっといま仕事が混んでて、こっちでサンプルデータ用意して、
コード書けないのですが・・・

この辺は、べたに考えて試行錯誤していけば出来そうです。
ちょっと頑張ってみて〜

【61220】Re:外部データ読み込みVB
発言  neptune  - 09/4/16(木) 15:43 -

引用なし
パスワード
   ▼紅ほっぺ さん:
こんにちは

例えば、sheet1のA1〜C3をsheet2のA1〜C3に転記したい場合
Sub t()
Worksheets("Sheet2").Range("A1:C3").Value = Worksheets("Sheet1").Range("A1:C3").Value
End Sub
とやればすみます。

これを自分の転記したい場所に変えて、変更した方が簡単ではないですか?
これを3回繰り返すのが簡単と思いますけど。

所でUPしたソースは自分で書いていると思いますが、
何をやっているかは理解してますよね?
>A1からA2,A3と行の数が増えていくに従って、抽出先のシートでも行を増やして
>反映したい場合、VBをどう書けばいいのか思いつきません。。
転記元の行数をカウントし、その行数に転記回数が達したら転記先の
行数を増やすだけです。

【61228】つんさん、neptuneさん、ありがとうござ...
お礼  紅ほっぺ  - 09/4/17(金) 15:14 -

引用なし
パスワード
   1晩かかりましたが(爆)、
なんとか

For gyo2 = 1 To 14
    zentai = SH.Range(SH.Cells(gyo2, 1), SH.Cells(gyo2, 7)).Value
    retsu = 1
    For Each zentai In SH.Range(SH.Cells(gyo2, 1), SH.Cells(gyo2, 7))
      skb.Worksheets("抽出").Cells(gyo, retsu) = zentai
      retsu = retsu + 1
    Next
    gyo = gyo + 1
Next

で出来ました><。

ちなみに最初に投稿したコードは、仕組みは理解はしているつもりなのですが、ネットでひろってきたコードを切り貼りしたものなので、自分で書いたものとはいえないですm(_ _;)m
まだイチから書くことができません。。

お手数をおかけいたしましたが、アドバイスありがとうございました!!(^^)

3600 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free