Excel VBA質問箱 IV

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

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


40094 / 76732 ←次へ | 前へ→

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

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

Sheet1のA1、Sheet2のC1〜P1には、必ず数値が入っているという
前提で・・・・、

標準モジュールに
'=============================================================
Sub main()
  Dim nomvarray() As String
  Dim nomvcnt 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
  nomvcnt = 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)
         If Evaluate("SUM(COUNTIF(" & add & "," & add & "))") = .Count Then
           MsgBox bk.Name & " 転記処理を行う"
           '    実際は、ここで転記処理を行う
           ret = 0
           End If
         End With
        End If
      If ret <> 0 Then
        ReDim Preserve nomvarray(1 To nomvcnt + 1)
        nomvarray(nomvcnt + 1) = .Name
        nomvcnt = nomvcnt + 1
        End If
      .Close False
      End With
     End If
    Next
  If nomvcnt > 0 Then
    MsgBox "転記しなかったブックは、" & vbCrLf & vbCrLf & Join(nomvarray(), vbCrLf)
    End If
  Set fls = Nothing
  Set fl = Nothing
End Sub
どのように転記するのかわかりませんが、
条件チェックは上記のような処理で可能です。

検討してみてください。
1 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 お礼

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