Excel VBA質問箱 IV

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

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


72097 / 76733 ←次へ | 前へ→

【9123】Re:エクセルにインポート(エクスポート?)する
回答  ichinose  - 03/11/19(水) 2:46 -

引用なし
パスワード
   ▼hana さん:
こんばんは。


>http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=6470;id=excel
>を参考にさせて頂き、作成しました。
>やりたい点は、
>1.インポート先を閉じていて、インポート元となるファイルを開いた状態でインポートしたい。
>  (インポート元にはシートが複数あり、そのときactiveのシートをインポートしたい。)
>2.セルAからVの2行目からのデータをインポートしたい。
>  (インポート元、インポート先とも、1行目は列名を表示しているので、2行目から行いたい。)
>3.インポート先のファイルにデータを蓄積していきたい。

3回読み返しましたが、これは、エクスポートということですよね?

>Sub import()
>  With ThisWorkbook.ActiveSheet.Range("A:V")
>  .Formula = "=if(" & _
>    "'C:\インポート元ファイルの場所\[Data.xls]ActiveSheet'!A1=" & _

'このエラーは、ActiveSheetが原因です。こういう記述はできません。
'(ActiveSheetというシート名があるなら話は違ってきますが・・・)

>        """"",""""," & _
>        "'C:\インポート元ファイルの場所\[Data.xls]ActiveSheet'!A1)"
>       .Value = .Value
>    End With
>End Sub
で、たぶんリンク貼付では無理だと思いますよ。
もし、もし、上記のようなコードで可能だとしても処理速度は大きくは変わりませんよ。

本当は、両方開いて、値を移す方法が一般的だし、簡単だし、・・・
ですが、
私も初めてだったのでTRYしてみました。

hana さんの仕様では、「アクティブシートのA列からV列の値を開いていないBOOK2.XLSに追加する」ですが、以下のコードは、A列からB列を追加するになっていますので、確認後、変更して下さい。
ADOを使いましたので、参照設定で
「Microsoft ActiveX Data Objects 2.X Library」(私は、2.5でした)を
チェックして下さい。
標準モジュール(Module1)に、
'=====================================================================
Sub main()
  Dim sql_str As String
  If open_ado("D:\My Documents\TESTエリア\ExportBK.xls") = 0 Then
'   接続処理   ↑ここにエクスポート先ブックをフルネームで指定   
    sql_str = "[Sheet1$];"
'          エクスポート先のシート名の後ろに「$」を付ける
    If open_rs(sql_str) = 0 Then 'レコードセットのオープン
     With ActiveSheet
       Set rng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
'      ↑アクティブシートのA列の入力範囲を取得
       End With
     For idx = 1 To rng.Count
       If add_rs(rng.Cells(idx).Resize(1, 2)) <> 0 Then
'             ↑A列とB列を1行づつ追加 V列までなら2を22に変更
        Exit For
        End If
       Next idx
     rs_close 'レコードセットのクローズ
     End If
    close_ado 'エクスポートブックへの接続解除
  Else
    MsgBox "接続失敗"
    End If
End Sub

標準モジュール(Module2)に、
'================================================================
Public cn As New ADODB.Connection
Public rs As New ADODB.Recordset
'================================================================
Function open_ado(book_fullname As String) As Long
'excelブックに接続
  On Error Resume Next
  link_opt = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
       "Data Source=" & book_fullname & ";" & _
       "Extended Properties=Excel 8.0;"
  cn.Open link_opt
  open_ado = Err.Number
  On Error GoTo 0
End Function
'================================================================
Sub close_ado()
'接続解除
  On Error Resume Next
  cn.Close
  On Error GoTo 0
End Sub
'================================================================
Function open_rs(sql_str As String) As Long
'レコードセットのオープン
  On Error Resume Next
  rs_close
  rs.Open sql_str, cn, adOpenStatic, adLockOptimistic
  If Err.Number <> 0 Then
    MsgBox Error$(Err.Number)
    End If
  open_rs = Err.Number
  On Error GoTo 0
End Function
'=================================================================
Function add_rs(rng As Range) As Long
'データレコードの追加
  On Error GoTo err_add_rs
  With rs
   .AddNew
   For idx = 1 To rng.Count
     .Fields(idx - 1).Value = rng.Cells(idx).Value
     Next idx
   .Update
   End With
  add_rs = 0
ret_add_rs:
  On Error GoTo 0
  Exit Function
err_add_rs:
  MsgBox Error$(Err.Number)
  add_rs = Err.Number
  Resume ret_add_rs
End Function
'===================================================================
Sub rs_close()
'レコードセットのクローズ
  On Error Resume Next
  rs.Close
  On Error GoTo 0
End Sub

こちらで確認した限りでは、正しく追加できていますが、
確認してみて下さい。

2 hits

【9098】エクセルにインポート(エクスポート?)する hana 03/11/18(火) 15:52 質問
【9123】Re:エクセルにインポート(エクスポート?)... ichinose 03/11/19(水) 2:46 回答
【9135】Re:エクセルにインポート(エクスポート?)... hana 03/11/19(水) 11:58 質問
【9162】Re:エクセルにインポート(エクスポート?)... ichinose 03/11/19(水) 19:13 回答
【9202】Re:エクセルにインポート(エクスポート?)... hana 03/11/21(金) 9:48 お礼

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