Excel VBA質問箱 IV

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

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


39952 / 76738 ←次へ | 前へ→

【41890】Re:複数ブックのデータを2条件により転記しない方法
発言  ichinose  - 06/8/25(金) 7:34 -

引用なし
パスワード
   ▼tanaka さん:
おはようございます。
再現ができないので対処法が私にはわかりませんが、

>エラーメッセージは
>「実行時エラー'1004'
>'\\sst\??-\担当別\商品一覧表\八王子.xlsが見つかりません。ファイル名および
>ファイルの保存場所が正しいかどうか確認してください。
Fl.Pathで正しくパスが取得できていないという事ですね!!

因みに以下のコードではどうでしょうか?
'==========================================================
Sub main()
  Dim nomvarray1() As String
  Dim nomvarray2() As String
  Dim nomvcnt1 As Long
  Dim nomvcnt2 As Long
  Dim fls As Object
  Dim ret As Long
  Dim foldnm As String
  Dim fl As Object
  Dim add As String
  Dim bk As Workbook
  Dim mes1 As String
  Dim mes2 As String
  Dim rcnt As Long
  nomvcnt1 = 0: nomvcnt2 = 0
  foldnm = "D:\My Documents\TESTエリア\testarea2002\testfold"
  '        実際に検査するフォルダ名 ↑
  Set fls = CreateObject("scripting.filesystemobject").GetFolder(foldnm).Files
  For Each fl In fls
   
    If UCase(fl.Name) Like UCase("*.xls") Then
     '↑指定フォルダ内にあるExcelブックだったら?
     ret = 1
     Set bk = Workbooks.Open(foldnm & "\" & fl.name)
     With bk
      If .Worksheets("sheet1").Range("a1").Value = .Worksheets("sheet2").Range("c1").Value Then
        With .Worksheets("sheet2").Range("c1:p1")
         add = .Address(, , , True)
         rcnt = .Count
         End With
        If Evaluate("SUM(COUNTIF(" & add & "," & add & "))") = rcnt Then
         MsgBox bk.Name & " 転記処理を行う"
         '    実際は、ここで転記処理を行う
        
        Else
         ReDim Preserve nomvarray2(1 To nomvcnt2 + 1)
         nomvarray2(nomvcnt2 + 1) = .Name
         nomvcnt2 = nomvcnt2 + 1
         End If
         
      Else
        ReDim Preserve nomvarray1(1 To nomvcnt1 + 1)
        nomvarray1(nomvcnt1 + 1) = .Name
        nomvcnt1 = nomvcnt1 + 1
        End If
      .Close False
      End With
     End If
    Next
  
  If nomvcnt1 > 0 Or nomvcnt2 > 0 Then
    If nomvcnt1 > 0 Then
     mes1 = "1.A1とC1のNO.が一致していません" & vbCrLf & Join(nomvarray2(), vbCrLf)
     End If
    If nomvcnt2 > 0 Then
     mes2 = "2.NO.が重複しています" & vbCrLf & Join(nomvarray1(), vbCrLf)
     End If
     
    MsgBox "転記しなかったブックは、" & vbCrLf & vbCrLf & mes1 & vbCrLf & vbCrLf & mes2
    End If
  Set fls = Nothing
  Set fl = Nothing
End Sub

これでうまくいってしまうと、ますます現象の原因はわからなくなってしまいますが。

試してみてください。
0 hits

【41737】複数ブックのデータを2条件により転記しない方法 tanaka 06/8/21(月) 20:39 質問
【41740】Re:複数ブックのデータを2条件により転記... ichinose 06/8/21(月) 21:53 発言
【41788】Re:複数ブックのデータを2条件により転記... tanaka 06/8/22(火) 21:25 発言
【41791】Re:複数ブックのデータを2条件により転記... ichinose 06/8/22(火) 22:13 発言
【41793】Re:複数ブックのデータを2条件により転記... tanaka 06/8/22(火) 22:40 発言
【41796】Re:複数ブックのデータを2条件により転記... ichinose 06/8/23(水) 8:02 発言
【41836】Re:複数ブックのデータを2条件により転記... tanaka 06/8/23(水) 22:00 発言
【41849】Re:複数ブックのデータを2条件により転記... ichinose 06/8/24(木) 8:17 発言
【41877】Re:複数ブックのデータを2条件により転記... tanaka 06/8/24(木) 21:03 発言
【41890】Re:複数ブックのデータを2条件により転記... ichinose 06/8/25(金) 7:34 発言
【42004】Re:複数ブックのデータを2条件により転記... tanaka 06/8/28(月) 21:58 発言
【42005】Re:複数ブックのデータを2条件により転記... ichinose 06/8/28(月) 22:20 発言
【42022】Re:複数ブックのデータを2条件により転記... tanaka 06/8/29(火) 21:36 発言
【42059】Re:複数ブックのデータを2条件により転記... ichinose 06/8/30(水) 18:55 発言
【42069】Re:複数ブックのデータを2条件により転記... tanaka 06/8/30(水) 23:16 発言
【42076】Re:複数ブックのデータを2条件により転記... ichinose 06/8/31(木) 7:43 発言
【41752】Re:複数ブックのデータを2条件により転記... Kein 06/8/22(火) 0:45 回答
【41789】Re:複数ブックのデータを2条件により転記... tanaka 06/8/22(火) 21:48 お礼

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