Excel VBA質問箱 IV

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

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


39993 / 76738 ←次へ | 前へ→

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

引用なし
パスワード
   ▼tanaka さん:
おはようございます。

>実行時のエラー番号は1004で
>"\\sst\商品管理\担当別\商品一覧表\八王子.xls"のファイルが見つかりません。
手動操作でこのブックが開くことができるかも確認してください。
>ファイルの場所を確認してください。
>という感じの文章だったと思いますが・・・。
>
>
>次いで、しまって申し訳ないのですが
>転記できなかったファイル名は条件別に分けることはできますでしょうか?
>
>下記のブックは転記できませんでした。
>1.A1とC1のNO.が一致していません  
>新宿.xls
>大阪北.xls
>2.NO.が重複しています  
>京都.xls
>北海道.xls
>
これは、
'======================================================================
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(fl.Path)
     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 お礼

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