Excel VBA質問箱 IV

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

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


12032 / 13645 ツリー ←次へ | 前へ→

【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ですと、空白のセルを優先されてコピーされてしまうため、
>同一の列にデータがコピーされないという不具合がでてしまいました。
>出来れば、常に2行目にコピーされて、
>そのあとに1行追加されるような形にしたいのですが・・・

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

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

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

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


>実際はsheet1→Mois、sheet2→NOS、sheet3→SOLなので
>iを変数として使っている?(よく分からないのですが、なんとなく)ようなので
>規則正しく1、2、3と変化していないので、そこら辺は大丈夫なのでしょうか?

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 -

引用なし
パスワード
   ごめんなさい。
説明が曖昧でしたね。

1行目が各項目
2行目が新規のデータベースのコピー先
3行目は前回VBAを実行したときのデータ
4行目は前々回VBA・・・

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

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

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

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

それからIROCさんに改めて御礼申し上げます!!!

【12752】Re:ファイルを・・・
回答  IROC  - 04/4/14(水) 9:04 -

引用なし
パスワード
   データを最下行に追加するものだと思っていました。(^_^;)
たえず2行目なのですね。

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

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