Excel VBA質問箱 IV

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

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


39780 / 76732 ←次へ | 前へ→

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

引用なし
パスワード
   ▼tanaka さん:
>こんにちは。
>ありがとうございます。
>
>foldnmのフォルダ名は変えていません。
>set bk=Workbooks.Open(foldnm & "\" & fl.name)のカッコ内を変えました。
>あとは考えていただいた通りです。
>宜しくお願い致します。
>
>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 num as Range
>  Dim LRow as Long
>  
>  Thisworkbook.Worksheets("売上").Range("A1:Y65536").ClearContents
>  nomvcnt1 = 0: nomvcnt2 = 0
>  foldnm = "\\sst\商品管理\担当別"
>  Set fls = CreateObject("scripting.filesystemobject").GetFolder(foldnm).Files
>  For Each fl In fls
>    If UCase(fl.Name) Like UCase("*.xls") Then
>     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)
>        If Evaluate("SUM(COUNTIF(" & add & "," & add & "))") = .Count Then
>         MsgBox bk.Name & vbcLrf & " 転記処理を行います。"
>         
>          set num=bk.worksheets("担当").range("L4")
>          num.Copy
>          With thisworkbook.worksheets("売上")
>           LRow=.Range("A65536").End(xlUp).Row   
>           If LRow=1 then
>           .Range("A" & LRow).PasteSpecial xlPasteValues
>           Else
>           .Range("A" & LRow+1).PasteSpecial xlPasteValues
>           End If
>          End With
>       
>         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
>  Set num =Nothing
>End Sub
このコード正しく動いていますか?
With構文の使い方に間違いがありませんか?
再度確認してください。

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 お礼

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