Excel VBA質問箱 IV

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

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


65325 / 76733 ←次へ | 前へ→

【15983】Re:アクセスへデータの貼り付け 訂正
発言  ichinose  - 04/7/13(火) 21:53 -

引用なし
パスワード
   >'==============================================================
>Function put_rs(rng As Range) As Long
>'データのセット 
>'input : rng : 書き込みセル範囲
>'output: put_rs リターンコード 0正常 その他:異常
>  On Error Resume Next
>  With rs
>   .AddNew
>   For idx = 1 To rng.Count
>     .Fields(idx - 1).Value = rng.Cells(idx).Value
>     Next idx
>   .Update
>   End With
>  On Error GoTo 0
>End Function
↑を以下に訂正
'===================================================================
Function put_rs(rng As Range) As Long
  On Error GoTo err_put_rs
  put_rs = 0
  With rs
   .AddNew
   For idx = 1 To rng.Count
     .Fields(idx - 1).Value = rng.Cells(idx).Value
     Next idx
   .Update
   End With
ret_put_rs:
  On Error GoTo 0
  Exit Function
err_put_rs:
  put_rs = Err.Number
  MsgBox Error(Err.Number)
  Resume ret_put_rs
End Function


>もうひとつの方法は、tamago さんがおっしゃっていたオートフィルタを使いました。
>
>'=======================================================================
>Sub main2()
>  Dim c_db As String
>  Dim rng As Range
>  Dim crng As Range
>  Set rng = get_match_rng("=○") 'オートフィルタで条件に合うセル範囲の取得
>  If rng Is Nothing Then Exit Sub
>  flnm = Application.GetOpenFilename("追加したいDB,(*.mdb)")
>  If flnm <> False Then
>   c_db = flnm
>   If open_db(c_db) = 0 Then
>     If open_rs("ganyu") = 0 Then
>      For Each crng In rng
>        If put_rs(crng.Resize(, 10)) <> 0 Then
>         Stop
>         End If
>        Next
      call close_rs '←これ入れといて下さい
>      End If
>     MsgBox "データ追加成功"
>     close_db
>     End If
>   End If
>End Sub

1 hits

【15856】アクセスへデータの貼り付け tamago 04/7/9(金) 13:37 質問
【15857】Re:アクセスへデータの貼り付け IROC 04/7/9(金) 13:39 回答
【15862】Re:アクセスへデータの貼り付け tamago 04/7/9(金) 14:41 発言
【15869】Re:アクセスへデータの貼り付け IROC 04/7/9(金) 16:13 回答
【15871】Re:アクセスへデータの貼り付け ichinose 04/7/9(金) 16:26 発言
【15951】Re:アクセスへデータの貼り付け tamago 04/7/13(火) 9:36 発言
【15980】Re:アクセスへデータの貼り付け ichinose 04/7/13(火) 21:13 回答
【15983】Re:アクセスへデータの貼り付け 訂正 ichinose 04/7/13(火) 21:53 発言
【15985】Re:アクセスへデータの貼り付け 訂正 しん 04/7/13(火) 23:07 発言
【15988】Re:アクセスへデータの貼り付け 訂正 ichinose 04/7/13(火) 23:36 発言
【15991】Re:アクセスへデータの貼り付け 訂正 しん 04/7/14(水) 0:39 お礼

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