Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
12033 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【12718】ファイルを・・・ 素人 04/4/13(火) 12:55 質問
【12729】Re:ファイルを・・・ IROC 04/4/13(火) 14:09 回答
【12734】Re:ファイルを・・・ 素人 04/4/13(火) 15:01 お礼
【12741】Re:ファイルを・・・ IROC 04/4/13(火) 17:30 回答
【12742】Re:ファイルを・・・ IROC 04/4/13(火) 17:39 回答
【12745】Re:ファイルを・・・ 素人 04/4/13(火) 21:28 質問
【12752】Re:ファイルを・・・ IROC 04/4/14(水) 9:04 回答
【12718】ファイルを・・・
質問  素人  - 04/4/13(火) 12:55 -
引用なし
パスワード
   これがマクロで出来たら、すごく楽になるのですが・・・お力をお貸し下さい
！


ファイルa←マクロを設定するファイル
ファイルb←取得したいデータがあるファイル
（ファイルbは任意。取り出したいデータが入っている
セルは常に一緒です。）

−−−−−−−−−−−−−−−−−−−−−−

ファイルa−sheetDBにマクロを作り実行したとき、Excelとかの開くをクリッ
クしたときに出てくるようなWindowが出てきてファイルを選択すると、


　　　　　｜ファイルb−sheet1−A1
コピー元　｜ファイルb−sheet2−C2
　　　　　｜ファイルb−sheet3−D4

の各データを

　　　　　｜ファイルa−sheetDB−B2
コピー先　｜ファイルa−sheetDB−C2
　　　　　｜ファイルa−sheetDB−D2

のようにコピーしたいのです。

ただ、取り出したデータはデータベース化したいのでマクロを実行したらファ
イルa−sheetDBは常に1行追加させるような形にしたいと思っています。

最も厄介なのがコピー元のSheetがあったりなかったりすることです（ここで
いつもデバックが・・・）。例えば

ファイルbは

｜ファイルb−sheet1−A1
｜ファイルb−sheet2−C2
｜ファイルb−sheet3−D4

なのですが

ファイルcは

｜ファイルb−sheet1−A1
｜ファイルb−sheet2−C2は削除されていて存在しない
｜ファイルb−sheet3−D4
（この場合、ファイルb−sheet2−C2のコピー先（ファイルa−sheetDB−C2）
にはデータが入らないブランクのセルにしたいのですが・・・

こんな事マクロで出来ます？


自分でやると存在しないsheetでデバックがでてしまいます。

甘えて良いのであれば、ファイルを選択して・・・の所からのマクロを教えて
いただければとても嬉しいです。

何とかよろしくお願いしますm(__)m
【12729】Re:ファイルを・・・
回答  IROC  - 04/4/13(火) 14:09 -
引用なし
パスワード
   できますよ。

まずファイル選択ダイアログの定番は、
GetOpenFilename メソッド
です。

動作未確認の走り書きですが。


Sub sample()
Dim FileName As Variant
Dim wb As Workbook
Dim i As Long

　　FileName = Application.GetOpenFilename("Excelファイル (*.xls), *.xls")

　　If FileName = False Then
　　　　MsgBox "キャンセルされました"
　　　　Exit Sub
　　End If

　　Set wb = Workbooks.Open(FileName)
　　

With ThisWorkbook.Worksheets("sheetDB")
　　　　
　　For i = 1 To wb.Worksheets.Count
　　　　Select Case Worksheets(i).Name
　　　　Case "Sheet1"
　　　　　　.Range("B65536").End(xlUp).Offset(1).Value = wb.Worksheets(i).Range("A1").Value
　　　　Case "Sheet2"
　　　　　　.Range("C65536").End(xlUp).Offset(1).Value = wb.Worksheets(i).Range("C2").Value
　　　　Case "Sheet3"
　　　　　　.Range("D65536").End(xlUp).Offset(1).Value = wb.Worksheets(i).Range("D4").Value
　　　　End Select
　　Next i
　　
　　wb.Close False
　　
End With
End Sub
【12734】Re:ファイルを・・・
お礼  素人  - 04/4/13(火) 15:01 -
引用なし
パスワード
   ありがとうございます。
試してみます！！
【12741】Re:ファイルを・・・
回答  IROC  - 04/4/13(火) 17:30 -
引用なし
パスワード
   >教えていただいたVBAですと、空白のセルを優先されてコピーされてしまうため、
>同一の列にデータがコピーされないという不具合がでてしまいました。
>出来れば、常に２行目にコピーされて、
>そのあとに１行追加されるような形にしたいのですが・・・

仕様から考えてみれば、そのとおりですね。失礼しました。(^_^;)

しかし、場合によって、データのないシートがあるので、
B,C,Dのどの列が最下行か分からないです。

最下行を判別することのできる列はありますか？

それともB,C,Dの中から判断しないとダメですか？


>実際はsheet1→Mois、sheet2→NOS、sheet3→SOLなので
>iを変数として使っている？（よく分からないのですが、なんとなく）ようなので
>規則正しく１、２、３と変化していないので、そこら辺は大丈夫なのでしょうか？

select case でシート名を条件分岐しています。
各 case で "Sheet1" のようにシート名によって
判別しているので、その部分を変更して下さい。
【12742】Re:ファイルを・・・
回答  IROC  - 04/4/13(火) 17:39 -
引用なし
パスワード
   ctrl + shift + *　(CurrentRegion) で、最下行を判別してみました。

Sub Sample2()
Dim FileName As Variant
Dim wb As Workbook
Dim i As Long
Dim myRow As Long

　　FileName = Application.GetOpenFilename("Excelファイル (*.xls), *.xls")

　　If FileName = False Then
　　　　MsgBox "キャンセルされました"
　　　　Exit Sub
　　End If

　　Set wb = Workbooks.Open(FileName)
　　

With ThisWorkbook.Worksheets("sheetDB")

　　myRow = .Range("B1").CurrentRegion.Row + 1

　　For i = 1 To wb.Worksheets.Count
　　　　
　　　　Select Case Worksheets(i).Name
　　　　Case "Mois"
　　　　　　.Cells(2, myRow).Value = wb.Worksheets(i).Range("A1").Value
　　　　Case "NOS"
　　　　　　.Cells(3, myRow).Value = wb.Worksheets(i).Range("C2").Value
　　　　Case "SOL"
　　　　　　.Cells(4, myRow).Value = wb.Worksheets(i).Range("D4").Value
　　　　End Select
　　　　
　　Next i
　　
　　wb.Close False
　　
End With
End Sub
【12745】Re:ファイルを・・・
質問  素人  - 04/4/13(火) 21:28 -
引用なし
パスワード
   ごめんなさい。
説明が曖昧でしたね。

１行目が各項目
２行目が新規のデータベースのコピー先
３行目は前回VBAを実行したときのデータ
４行目は前々回VBA・・・

なので、判別とかいう高等技術を使うのではなく、
２行目に取得データをコピーする前に、単純に１行追加して
過去のデータは一段下がるという感じにしたいのです。

Rows("2:2").Select
Selection.Insert Shift:=xlDown

みたいな・・・これをどこに入れればうまくいくのか、そして
もっと単純なVBAがあるのか知りたいです。

VBAはホントに入り口に入ったばかりで知識が浅いのです。
お手数ですが、教えてもらえればうれしいっッス！

それからIROCさんに改めて御礼申し上げます！！！
【12752】Re:ファイルを・・・
回答  IROC  - 04/4/14(水) 9:04 -
引用なし
パスワード
   データを最下行に追加するものだと思っていました。(^_^;)
たえず２行目なのですね。

Sub Sample3()
Dim FileName As Variant
Dim wb As Workbook
Dim i As Long
Dim myRow As Long

　　FileName = Application.GetOpenFilename("Excelファイル (*.xls), *.xls")

　　If FileName = False Then
　　　　MsgBox "キャンセルされました"
　　　　Exit Sub
　　End If

　　Set wb = Workbooks.Open(FileName)
　　

With ThisWorkbook.Worksheets("sheetDB")

　　Rows(2).Insert Shift:=xlDown

　　For i = 1 To wb.Worksheets.Count　　　　
　　　　Select Case Worksheets(i).Name
　　　　Case "Mois"
　　　　　　.Range("B2").Value = wb.Worksheets(i).Range("A1").Value
　　　　Case "NOS"
　　　　　　.Range("C2").Value = wb.Worksheets(i).Range("C2").Value
　　　　Case "SOL"
　　　　　　.Range("D2").Value = wb.Worksheets(i).Range("D4").Value
　　　　End Select　　　　
　　Next i
　　
　　wb.Close False
　　
End With
End Sub
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
12033 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free