[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『コードをすっきりさせたい』（ふみ）
日程表ファイルが複数収納してあるフォルダを検索して、
データを読み取るコードを作りました。
動作は問題ないのですが、素人の為、単純なコードの繰り返しで
膨大なコードになってしまっています。
また現在は各日程表ファイルの、「２ケ月用」というシートだけを
検索していますが、各ファイルには「３ケ月用」「４ケ月用」の
あと２シートがあり、同じ様にコードを作るとさらに膨大に
なってしまいます。
「３ケ月用」と「４ケ月用」は、Target1〜3のセル位置が異なりますが、
残りのTargetは全て「２ケ月用」と同じセル位置です。
ＸＰでエクセル２００７を使用しています。
御教示をよろしくお願いします。
Sub Sample3()
Dim i As Long, buf As String, Target1 As String, Target2 As String
Dim Target3 As String, Target4 As String, Target5 As String
Dim Target6 As String, Target7 As String, Target8 As String
Dim Target9 As String, Target10 As String, Target11 As String
Dim Target12 As String, Target13 As String, Target14 As String
Dim Target15 As String, Target16 As String, Target17 As String
Dim Target18 As String, Target19 As String, Target20 As String
Dim Target21 As String, Target22 As String, Target23 As String
Dim Target24 As String, Target25 As String, Target26 As String
Dim Target27 As String, Target28 As String, Target29 As String
Dim Target30 As String, Target31 As String, Target32 As String
Dim Target33 As String, Target34 As String, Target35 As String
Dim Target36 As String, Target37 As String, Target38 As String
Dim Target39 As String, Target40 As String, Target41 As String
Dim Target42 As String, Target43 As String, Target44 As String
Dim Target45 As String, Target46 As String, Target47 As String
Dim Target48 As String, Target49 As String, Target50 As String
Dim Target51 As String, Target52 As String, Target53 As String
Dim Target54 As String, Target55 As String, Target56 As String
Dim Target57 As String, Target58 As String, Target59 As String
Dim Target60 As String, Target61 As String, Target62 As String
Dim Target63 As String, Target64 As String, Target65 As String
Dim Target66 As String, Target67 As String, Target68 As String
Dim Target69 As String, Target70 As String, Target71 As String
Dim Target72 As String, Target73 As String, Target74 As String
Dim Target75 As String, Target76 As String, Target77 As String
Dim Target78 As String, Target79 As String, Target80 As String
Dim Target81 As String, Target82 As String, Target83 As String
Dim Target84 As String, Target85 As String, Target86 As String
Dim Target87 As String, Target88 As String, Target89 As String
Dim Target90 As String, Target91 As String, Target92 As String
Dim Target93 As String, Target94 As String, Target95 As String
Dim Target96 As String, Target97 As String, Target98 As String
Dim Target99 As String, Target100 As String, Target101 As String
Dim Target102 As String, Target103 As String, Target104 As String
Dim Target105 As String, Target106 As String, Target107 As String
Dim Target108 As String, Target109 As String, Target110 As String
Dim Target111 As String, Target112 As String, Target113 As String
Dim Target114 As String, Target115 As String, Target116 As String
Dim Target117 As String, Target118 As String, Target119 As String
Dim Target120 As String, Target121 As String, Target122 As String
Dim Target123 As String, Target124 As String, Target125 As String
Dim Target126 As String, Target127 As String, Target128 As String
Dim Target129 As String, Target130 As String, Target131 As String
Dim Target132 As String, Target133 As String, Target134 As String
Dim Target135 As String, Target136 As String, Target137 As String
Dim Target138 As String, Target139 As String, Target140 As String
Dim Target141 As String
Const Path = "W:\ふみ\社内（原価・日程）管理表\"
buf = Dir(Path & "*.xlsm")
Do While buf <> ""
Target1 = "'" & Path & "[" & buf & "]２ケ月用'!R2C17"
Target2 = "'" & Path & "[" & buf & "]２ケ月用'!R4C17"
Target3 = "'" & Path & "[" & buf & "]２ケ月用'!R6C17"
Target4 = "'" & Path & "[" & buf & "]２ケ月用'!R12C5"
Target5 = "'" & Path & "[" & buf & "]２ケ月用'!R12C6"
Target6 = "'" & Path & "[" & buf & "]２ケ月用'!R14C5"
Target7 = "'" & Path & "[" & buf & "]２ケ月用'!R14C6"
Target8 = "'" & Path & "[" & buf & "]２ケ月用'!R16C5"
Target9 = "'" & Path & "[" & buf & "]２ケ月用'!R16C6"
Target10 = "'" & Path & "[" & buf & "]２ケ月用'!R18C5"
Target11 = "'" & Path & "[" & buf & "]２ケ月用'!R18C6"
Target12 = "'" & Path & "[" & buf & "]２ケ月用'!R20C5"
Target13 = "'" & Path & "[" & buf & "]２ケ月用'!R20C6"
Target14 = "'" & Path & "[" & buf & "]２ケ月用'!R22C5"
Target15 = "'" & Path & "[" & buf & "]２ケ月用'!R22C6"
Target16 = "'" & Path & "[" & buf & "]２ケ月用'!R24C5"
Target17 = "'" & Path & "[" & buf & "]２ケ月用'!R24C6"
Target18 = "'" & Path & "[" & buf & "]２ケ月用'!R26C5"
Target19 = "'" & Path & "[" & buf & "]２ケ月用'!R26C6"
Target20 = "'" & Path & "[" & buf & "]２ケ月用'!R28C5"
Target21 = "'" & Path & "[" & buf & "]２ケ月用'!R28C6"
Target22 = "'" & Path & "[" & buf & "]２ケ月用'!R30C5"
Target23 = "'" & Path & "[" & buf & "]２ケ月用'!R30C6"
Target24 = "'" & Path & "[" & buf & "]２ケ月用'!R32C5"
Target25 = "'" & Path & "[" & buf & "]２ケ月用'!R32C6"
Target26 = "'" & Path & "[" & buf & "]２ケ月用'!R34C5"
Target27 = "'" & Path & "[" & buf & "]２ケ月用'!R34C6"
Target28 = "'" & Path & "[" & buf & "]２ケ月用'!R36C5"
Target29 = "'" & Path & "[" & buf & "]２ケ月用'!R36C6"
Target30 = "'" & Path & "[" & buf & "]２ケ月用'!R38C5"
Target31 = "'" & Path & "[" & buf & "]２ケ月用'!R38C6"
Target32 = "'" & Path & "[" & buf & "]２ケ月用'!R40C5"
Target33 = "'" & Path & "[" & buf & "]２ケ月用'!R40C6"
Target34 = "'" & Path & "[" & buf & "]２ケ月用'!R42C5"
Target35 = "'" & Path & "[" & buf & "]２ケ月用'!R42C6"
Target36 = "'" & Path & "[" & buf & "]２ケ月用'!R44C5"
Target37 = "'" & Path & "[" & buf & "]２ケ月用'!R44C6"
Target38 = "'" & Path & "[" & buf & "]２ケ月用'!R46C5"
Target39 = "'" & Path & "[" & buf & "]２ケ月用'!R46C6"
Target40 = "'" & Path & "[" & buf & "]２ケ月用'!R12C7"
Target41 = "'" & Path & "[" & buf & "]２ケ月用'!R12C8"
Target42 = "'" & Path & "[" & buf & "]２ケ月用'!R14C7"
Target43 = "'" & Path & "[" & buf & "]２ケ月用'!R14C8"
Target44 = "'" & Path & "[" & buf & "]２ケ月用'!R16C7"
Target45 = "'" & Path & "[" & buf & "]２ケ月用'!R16C8"
Target46 = "'" & Path & "[" & buf & "]２ケ月用'!R18C7"
Target47 = "'" & Path & "[" & buf & "]２ケ月用'!R18C8"
Target48 = "'" & Path & "[" & buf & "]２ケ月用'!R20C7"
Target49 = "'" & Path & "[" & buf & "]２ケ月用'!R20C8"
Target50 = "'" & Path & "[" & buf & "]２ケ月用'!R22C7"
Target51 = "'" & Path & "[" & buf & "]２ケ月用'!R22C8"
Target52 = "'" & Path & "[" & buf & "]２ケ月用'!R24C7"
Target53 = "'" & Path & "[" & buf & "]２ケ月用'!R24C8"
Target54 = "'" & Path & "[" & buf & "]２ケ月用'!R26C7"
Target55 = "'" & Path & "[" & buf & "]２ケ月用'!R26C8"
Target56 = "'" & Path & "[" & buf & "]２ケ月用'!R28C7"
Target57 = "'" & Path & "[" & buf & "]２ケ月用'!R28C8"
Target58 = "'" & Path & "[" & buf & "]２ケ月用'!R30C7"
Target59 = "'" & Path & "[" & buf & "]２ケ月用'!R30C8"
Target60 = "'" & Path & "[" & buf & "]２ケ月用'!R32C7"
Target61 = "'" & Path & "[" & buf & "]２ケ月用'!R32C8"
Target62 = "'" & Path & "[" & buf & "]２ケ月用'!R34C7"
Target63 = "'" & Path & "[" & buf & "]２ケ月用'!R34C8"
Target64 = "'" & Path & "[" & buf & "]２ケ月用'!R36C7"
Target65 = "'" & Path & "[" & buf & "]２ケ月用'!R36C8"
Target66 = "'" & Path & "[" & buf & "]２ケ月用'!R38C7"
Target67 = "'" & Path & "[" & buf & "]２ケ月用'!R38C8"
Target68 = "'" & Path & "[" & buf & "]２ケ月用'!R40C7"
Target69 = "'" & Path & "[" & buf & "]２ケ月用'!R40C8"
Target70 = "'" & Path & "[" & buf & "]２ケ月用'!R42C7"
Target71 = "'" & Path & "[" & buf & "]２ケ月用'!R42C8"
Target72 = "'" & Path & "[" & buf & "]２ケ月用'!R44C7"
Target73 = "'" & Path & "[" & buf & "]２ケ月用'!R44C8"
Target74 = "'" & Path & "[" & buf & "]２ケ月用'!R46C7"
Target75 = "'" & Path & "[" & buf & "]２ケ月用'!R46C8"
Target76 = "'" & Path & "[" & buf & "]２ケ月用'!R12C3"
Target77 = "'" & Path & "[" & buf & "]２ケ月用'!R13C3"
Target78 = "'" & Path & "[" & buf & "]２ケ月用'!R14C3"
Target79 = "'" & Path & "[" & buf & "]２ケ月用'!R15C3"
Target80 = "'" & Path & "[" & buf & "]２ケ月用'!R16C3"
Target81 = "'" & Path & "[" & buf & "]２ケ月用'!R17C3"
Target82 = "'" & Path & "[" & buf & "]２ケ月用'!R18C3"
Target83 = "'" & Path & "[" & buf & "]２ケ月用'!R20C3"
Target84 = "'" & Path & "[" & buf & "]２ケ月用'!R22C3"
Target85 = "'" & Path & "[" & buf & "]２ケ月用'!R23C3"
Target86 = "'" & Path & "[" & buf & "]２ケ月用'!R24C3"
Target87 = "'" & Path & "[" & buf & "]２ケ月用'!R26C3"
Target88 = "'" & Path & "[" & buf & "]２ケ月用'!R27C3"
Target89 = "'" & Path & "[" & buf & "]２ケ月用'!R28C3"
Target90 = "'" & Path & "[" & buf & "]２ケ月用'!R29C3"
Target91 = "'" & Path & "[" & buf & "]２ケ月用'!R30C3"
Target92 = "'" & Path & "[" & buf & "]２ケ月用'!R31C3"
Target93 = "'" & Path & "[" & buf & "]２ケ月用'!R32C3"
Target94 = "'" & Path & "[" & buf & "]２ケ月用'!R33C3"
Target95 = "'" & Path & "[" & buf & "]２ケ月用'!R34C3"
Target96 = "'" & Path & "[" & buf & "]２ケ月用'!R35C3"
Target97 = "'" & Path & "[" & buf & "]２ケ月用'!R36C3"
Target98 = "'" & Path & "[" & buf & "]２ケ月用'!R37C3"
Target99 = "'" & Path & "[" & buf & "]２ケ月用'!R38C3"
Target100 = "'" & Path & "[" & buf & "]２ケ月用'!R39C3"
Target101 = "'" & Path & "[" & buf & "]２ケ月用'!R40C3"
Target102 = "'" & Path & "[" & buf & "]２ケ月用'!R41C3"
Target103 = "'" & Path & "[" & buf & "]２ケ月用'!R42C3"
Target104 = "'" & Path & "[" & buf & "]２ケ月用'!R43C3"
Target105 = "'" & Path & "[" & buf & "]２ケ月用'!R44C3"
Target106 = "'" & Path & "[" & buf & "]２ケ月用'!R45C3"
Target107 = "'" & Path & "[" & buf & "]２ケ月用'!R46C3"
Target108 = "'" & Path & "[" & buf & "]２ケ月用'!R47C3"
Target109 = "'" & Path & "[" & buf & "]２ケ月用'!R12C4"
Target110 = "'" & Path & "[" & buf & "]２ケ月用'!R13C4"
Target111 = "'" & Path & "[" & buf & "]２ケ月用'!R14C4"
Target112 = "'" & Path & "[" & buf & "]２ケ月用'!R15C4"
Target113 = "'" & Path & "[" & buf & "]２ケ月用'!R16C4"
Target114 = "'" & Path & "[" & buf & "]２ケ月用'!R17C4"
Target115 = "'" & Path & "[" & buf & "]２ケ月用'!R18C4"
Target116 = "'" & Path & "[" & buf & "]２ケ月用'!R20C4"
Target117 = "'" & Path & "[" & buf & "]２ケ月用'!R22C4"
Target118 = "'" & Path & "[" & buf & "]２ケ月用'!R23C4"
Target119 = "'" & Path & "[" & buf & "]２ケ月用'!R24C4"
Target120 = "'" & Path & "[" & buf & "]２ケ月用'!R26C4"
Target121 = "'" & Path & "[" & buf & "]２ケ月用'!R27C4"
Target122 = "'" & Path & "[" & buf & "]２ケ月用'!R28C4"
Target123 = "'" & Path & "[" & buf & "]２ケ月用'!R29C4"
Target124 = "'" & Path & "[" & buf & "]２ケ月用'!R30C4"
Target125 = "'" & Path & "[" & buf & "]２ケ月用'!R31C4"
Target126 = "'" & Path & "[" & buf & "]２ケ月用'!R32C4"
Target127 = "'" & Path & "[" & buf & "]２ケ月用'!R33C4"
Target128 = "'" & Path & "[" & buf & "]２ケ月用'!R34C4"
Target129 = "'" & Path & "[" & buf & "]２ケ月用'!R35C4"
Target130 = "'" & Path & "[" & buf & "]２ケ月用'!R36C4"
Target131 = "'" & Path & "[" & buf & "]２ケ月用'!R37C4"
Target132 = "'" & Path & "[" & buf & "]２ケ月用'!R38C4"
Target133 = "'" & Path & "[" & buf & "]２ケ月用'!R39C4"
Target134 = "'" & Path & "[" & buf & "]２ケ月用'!R40C4"
Target135 = "'" & Path & "[" & buf & "]２ケ月用'!R41C4"
Target136 = "'" & Path & "[" & buf & "]２ケ月用'!R42C4"
Target137 = "'" & Path & "[" & buf & "]２ケ月用'!R43C4"
Target138 = "'" & Path & "[" & buf & "]２ケ月用'!R44C4"
Target139 = "'" & Path & "[" & buf & "]２ケ月用'!R45C4"
Target140 = "'" & Path & "[" & buf & "]２ケ月用'!R46C4"
Target141 = "'" & Path & "[" & buf & "]２ケ月用'!R47C4"
i = i + 4
Cells(i, 1) = buf
Cells(i, 2) = ExecuteExcel4Macro(Target1)
Cells(i, 3) = ExecuteExcel4Macro(Target2)
Cells(i, 4) = ExecuteExcel4Macro(Target3)
Cells(i, 7) = ExecuteExcel4Macro(Target4)
Cells(i, 8) = ExecuteExcel4Macro(Target5)
Cells(i, 9) = ExecuteExcel4Macro(Target6)
Cells(i, 10) = ExecuteExcel4Macro(Target7)
Cells(i, 11) = ExecuteExcel4Macro(Target8)
Cells(i, 12) = ExecuteExcel4Macro(Target9)
Cells(i, 13) = ExecuteExcel4Macro(Target10)
Cells(i, 14) = ExecuteExcel4Macro(Target11)
Cells(i, 15) = ExecuteExcel4Macro(Target12)
Cells(i, 16) = ExecuteExcel4Macro(Target13)
Cells(i, 17) = ExecuteExcel4Macro(Target14)
Cells(i, 18) = ExecuteExcel4Macro(Target15)
Cells(i, 19) = ExecuteExcel4Macro(Target16)
Cells(i, 20) = ExecuteExcel4Macro(Target17)
Cells(i, 21) = ExecuteExcel4Macro(Target18)
Cells(i, 22) = ExecuteExcel4Macro(Target19)
Cells(i, 23) = ExecuteExcel4Macro(Target20)
Cells(i, 24) = ExecuteExcel4Macro(Target21)
Cells(i, 25) = ExecuteExcel4Macro(Target22)
Cells(i, 26) = ExecuteExcel4Macro(Target23)
Cells(i, 27) = ExecuteExcel4Macro(Target24)
Cells(i, 28) = ExecuteExcel4Macro(Target25)
Cells(i, 29) = ExecuteExcel4Macro(Target26)
Cells(i, 30) = ExecuteExcel4Macro(Target27)
Cells(i, 31) = ExecuteExcel4Macro(Target28)
Cells(i, 32) = ExecuteExcel4Macro(Target29)
Cells(i, 33) = ExecuteExcel4Macro(Target30)
Cells(i, 34) = ExecuteExcel4Macro(Target31)
Cells(i, 35) = ExecuteExcel4Macro(Target32)
Cells(i, 36) = ExecuteExcel4Macro(Target33)
Cells(i, 37) = ExecuteExcel4Macro(Target34)
Cells(i, 38) = ExecuteExcel4Macro(Target35)
Cells(i, 39) = ExecuteExcel4Macro(Target36)
Cells(i, 40) = ExecuteExcel4Macro(Target37)
Cells(i, 41) = ExecuteExcel4Macro(Target38)
Cells(i, 42) = ExecuteExcel4Macro(Target39)
Cells(i + 1, 7) = ExecuteExcel4Macro(Target40)
Cells(i + 1, 8) = ExecuteExcel4Macro(Target41)
Cells(i + 1, 9) = ExecuteExcel4Macro(Target42)
Cells(i + 1, 10) = ExecuteExcel4Macro(Target43)
Cells(i + 1, 11) = ExecuteExcel4Macro(Target44)
Cells(i + 1, 12) = ExecuteExcel4Macro(Target45)
Cells(i + 1, 13) = ExecuteExcel4Macro(Target46)
Cells(i + 1, 14) = ExecuteExcel4Macro(Target47)
Cells(i + 1, 15) = ExecuteExcel4Macro(Target48)
Cells(i + 1, 16) = ExecuteExcel4Macro(Target49)
Cells(i + 1, 17) = ExecuteExcel4Macro(Target50)
Cells(i + 1, 18) = ExecuteExcel4Macro(Target51)
Cells(i + 1, 19) = ExecuteExcel4Macro(Target52)
Cells(i + 1, 20) = ExecuteExcel4Macro(Target53)
Cells(i + 1, 21) = ExecuteExcel4Macro(Target54)
Cells(i + 1, 22) = ExecuteExcel4Macro(Target55)
Cells(i + 1, 23) = ExecuteExcel4Macro(Target56)
Cells(i + 1, 24) = ExecuteExcel4Macro(Target57)
Cells(i + 1, 25) = ExecuteExcel4Macro(Target58)
Cells(i + 1, 26) = ExecuteExcel4Macro(Target59)
Cells(i + 1, 27) = ExecuteExcel4Macro(Target60)
Cells(i + 1, 28) = ExecuteExcel4Macro(Target61)
Cells(i + 1, 29) = ExecuteExcel4Macro(Target62)
Cells(i + 1, 30) = ExecuteExcel4Macro(Target63)
Cells(i + 1, 31) = ExecuteExcel4Macro(Target64)
Cells(i + 1, 32) = ExecuteExcel4Macro(Target65)
Cells(i + 1, 33) = ExecuteExcel4Macro(Target66)
Cells(i + 1, 34) = ExecuteExcel4Macro(Target67)
Cells(i + 1, 35) = ExecuteExcel4Macro(Target68)
Cells(i + 1, 36) = ExecuteExcel4Macro(Target69)
Cells(i + 1, 37) = ExecuteExcel4Macro(Target70)
Cells(i + 1, 38) = ExecuteExcel4Macro(Target71)
Cells(i + 1, 39) = ExecuteExcel4Macro(Target72)
Cells(i + 1, 40) = ExecuteExcel4Macro(Target73)
Cells(i + 1, 41) = ExecuteExcel4Macro(Target74)
Cells(i + 1, 42) = ExecuteExcel4Macro(Target75)
Cells(i + 2, 7) = ExecuteExcel4Macro(Target76)
Cells(i + 2, 8) = ExecuteExcel4Macro(Target77)
Cells(i + 2, 9) = ExecuteExcel4Macro(Target78)
Cells(i + 2, 10) = ExecuteExcel4Macro(Target79)
Cells(i + 2, 11) = ExecuteExcel4Macro(Target80)
Cells(i + 2, 12) = ExecuteExcel4Macro(Target81)
Cells(i + 2, 13) = ExecuteExcel4Macro(Target82)
Cells(i + 2, 15) = ExecuteExcel4Macro(Target83)
Cells(i + 2, 17) = ExecuteExcel4Macro(Target84)
Cells(i + 2, 18) = ExecuteExcel4Macro(Target85)
Cells(i + 2, 19) = ExecuteExcel4Macro(Target86)
Cells(i + 2, 21) = ExecuteExcel4Macro(Target87)
Cells(i + 2, 22) = ExecuteExcel4Macro(Target88)
Cells(i + 2, 23) = ExecuteExcel4Macro(Target89)
Cells(i + 2, 24) = ExecuteExcel4Macro(Target90)
Cells(i + 2, 25) = ExecuteExcel4Macro(Target91)
Cells(i + 2, 26) = ExecuteExcel4Macro(Target92)
Cells(i + 2, 27) = ExecuteExcel4Macro(Target93)
Cells(i + 2, 28) = ExecuteExcel4Macro(Target94)
Cells(i + 2, 29) = ExecuteExcel4Macro(Target95)
Cells(i + 2, 30) = ExecuteExcel4Macro(Target96)
Cells(i + 2, 31) = ExecuteExcel4Macro(Target97)
Cells(i + 2, 32) = ExecuteExcel4Macro(Target98)
Cells(i + 2, 33) = ExecuteExcel4Macro(Target99)
Cells(i + 2, 34) = ExecuteExcel4Macro(Target100)
Cells(i + 2, 35) = ExecuteExcel4Macro(Target101)
Cells(i + 2, 36) = ExecuteExcel4Macro(Target102)
Cells(i + 2, 37) = ExecuteExcel4Macro(Target103)
Cells(i + 2, 38) = ExecuteExcel4Macro(Target104)
Cells(i + 2, 39) = ExecuteExcel4Macro(Target105)
Cells(i + 2, 40) = ExecuteExcel4Macro(Target106)
Cells(i + 2, 41) = ExecuteExcel4Macro(Target107)
Cells(i + 2, 42) = ExecuteExcel4Macro(Target108)
Cells(i + 3, 7) = ExecuteExcel4Macro(Target109)
Cells(i + 3, 8) = ExecuteExcel4Macro(Target110)
Cells(i + 3, 9) = ExecuteExcel4Macro(Target111)
Cells(i + 3, 10) = ExecuteExcel4Macro(Target112)
Cells(i + 3, 11) = ExecuteExcel4Macro(Target113)
Cells(i + 3, 12) = ExecuteExcel4Macro(Target114)
Cells(i + 3, 13) = ExecuteExcel4Macro(Target115)
Cells(i + 3, 15) = ExecuteExcel4Macro(Target116)
Cells(i + 3, 17) = ExecuteExcel4Macro(Target117)
Cells(i + 3, 18) = ExecuteExcel4Macro(Target118)
Cells(i + 3, 19) = ExecuteExcel4Macro(Target119)
Cells(i + 3, 21) = ExecuteExcel4Macro(Target120)
Cells(i + 3, 22) = ExecuteExcel4Macro(Target121)
Cells(i + 3, 23) = ExecuteExcel4Macro(Target122)
Cells(i + 3, 24) = ExecuteExcel4Macro(Target123)
Cells(i + 3, 25) = ExecuteExcel4Macro(Target124)
Cells(i + 3, 26) = ExecuteExcel4Macro(Target125)
Cells(i + 3, 27) = ExecuteExcel4Macro(Target126)
Cells(i + 3, 28) = ExecuteExcel4Macro(Target127)
Cells(i + 3, 29) = ExecuteExcel4Macro(Target128)
Cells(i + 3, 30) = ExecuteExcel4Macro(Target129)
Cells(i + 3, 31) = ExecuteExcel4Macro(Target130)
Cells(i + 3, 32) = ExecuteExcel4Macro(Target131)
Cells(i + 3, 33) = ExecuteExcel4Macro(Target132)
Cells(i + 3, 34) = ExecuteExcel4Macro(Target133)
Cells(i + 3, 35) = ExecuteExcel4Macro(Target134)
Cells(i + 3, 36) = ExecuteExcel4Macro(Target135)
Cells(i + 3, 37) = ExecuteExcel4Macro(Target136)
Cells(i + 3, 38) = ExecuteExcel4Macro(Target137)
Cells(i + 3, 39) = ExecuteExcel4Macro(Target138)
Cells(i + 3, 40) = ExecuteExcel4Macro(Target139)
Cells(i + 3, 41) = ExecuteExcel4Macro(Target140)
Cells(i + 3, 42) = ExecuteExcel4Macro(Target141)
buf = Dir()
Loop
End Sub
同じブックなら開いて閉じた方がよっぽど早いんじゃない？ ちょっと見てみたけど、 １、3-4列目、5-8列目、17列目で吸い出す行数が違う ２、吐き出すセルと吸い出すセルの規則性が見いだせない
どんな規則で書き出してるんですか？ （稲葉） 2013/11/01(金) 15:34
変数を置くメリットがあまりなさそうなので Cells(i, 2).Value = ExecuteExcel4Macro( "'" & Path & "[" & buf & "]２ケ月用'!R2C17") のようにまとめれば半分になりそうですが、参照先も記入先もあまり規則性がなさそうなので 下手にまとめる工夫をするよりは、今のようにおとなしく列挙したほうが管理はし易いと思います。
一応サンプルとして無理やりまとめてみましたが、かえってわかりずらくなったかもしれません。
Sub Sample()
Const Path = "W:\ふみ\社内（原価・日程）管理表\"
Dim PlaceInfo(3)
PlaceInfo(0) = Array("", _
"", "", "", "", "", "", "R12C5", "R12C6", "R14C5", "R14C6", _
"R16C5", "R16C6", "R18C5", "R18C6", "R20C5", "R20C6", "R22C5", "R22C6", "R24C5", "R24C6", _
"R26C5", "R26C6", "R28C5", "R28C6", "R30C5", "R30C6", "R32C5", "R32C6", "R34C5", "R34C6", _
"R36C5", "R36C6", "R38C5", "R38C6", "R40C5", "R40C6", "R42C5", "R42C6", "R44C5", "R44C6", _
"R46C5", "R46C6")
PlaceInfo(1) = Array("", _
"", "", "", "", "", "", "R12C7", "R12C8", "R14C7", "R14C8", _
"R16C7", "R16C8", "R18C7", "R18C8", "R20C7", "R20C8", "R22C7", "R22C8", "R24C7", "R24C8", _
"R26C7", "R26C8", "R28C7", "R28C8", "R30C7", "R30C8", "R32C7", "R32C8", "R34C7", "R34C8", _
"R36C7", "R36C8", "R38C7", "R38C8", "R40C7", "R40C8", "R42C7", "R42C8", "R44C7", "R44C8", _
"R46C7", "R46C8")
PlaceInfo(2) = Array("", _
"", "", "", "", "", "", "R12C3", "R13C3", "R14C3", "R15C3", _
"R16C3", "R17C3", "R18C3", "", "R20C3", "", "R22C3", "R23C3", "R24C3", "", _
"R26C3", "R27C3", "R28C3", "R29C3", "R30C3", "R31C3", "R32C3", "R33C3", "R34C3", "R35C3", _
"R36C3", "R37C3", "R38C3", "R39C3", "R40C3", "R41C3", "R42C3", "R43C3", "R44C3", "R45C3", _
"R46C3", "R47C3")
PlaceInfo(3) = Array("", _
"", "", "", "", "", "", "R12C4", "R13C4", "R14C4", "R15C4", _
"R16C4", "R17C4", "R18C4", "", "R20C4", "", "R22C4", "R23C4", "R24C4", "", _
"R26C4", "R27C4", "R28C4", "R29C4", "R30C4", "R31C4", "R32C4", "R33C4", "R34C4", "R35C4", _
"R36C4", "R37C4", "R38C4", "R39C4", "R40C4", "R41C4", "R42C4", "R43C4", "R44C4", "R45C4", _
"R46C4", "R47C4")
Dim filaName
filaName = Dir(Path & "*.xlsm")
Dim ar As Long
Dim r As Long
Dim c As Long
Dim preRef As String
Do While filaName <> ""
r = r + 4
preRef = "'" & Path & "[" & filaName & "]２ケ月用'!"
Cells(r, 1).Value = filaName
Cells(r, 2).Value = ExecuteExcel4Macro(preRef & "R4C17")
Cells(r, 3).Value = ExecuteExcel4Macro(preRef & "R6C17")
For ar = 0 To 3
For c = LBound(PlaceInfo(ar)) To UBound(PlaceInfo(ar))
If PlaceInfo(ar)(c) <> "" Then
Cells(r + ar, c).Value = ExecuteExcel4Macro(preRef & PlaceInfo(ar)(c))
End If
Next
Next
filaName = Dir()
Loop
End Sub
（Mook） 2013/11/01(金) 15:37
規則性が無い部分があって、手におえず助けを求めてしまいましたが、
Mookさんが仰る様に、素直に列挙した方が、素人の私にとって
管理が出来ると思います。
あと、２シートあるので、Targetは400を超えそうですが、
頑張ります。
ありがとう御座いました。
（ふみ）
（ふみ） 2013/11/01(金) 16:05
こんにちは
ExecuteExcel4Macro が良いのかどうかは別として、
Sub test()
Dim h As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim buf As String
Dim t(1 To 3, 1 To 5) As Variant
Dim s As Long
Dim sh As Worksheet
Const Path = "W:\ふみ\社内（原価・日程）管理表\"
t(1, 1) = "２ケ月用"
t(1, 2) = "Sheet1"
t(1, 3) = "R2C17"
t(1, 4) = "R4C17"
t(1, 5) = "R6C17"
t(2, 1) = "３ケ月用"
t(2, 2) = "Sheet2"
t(2, 3) = "R2C18"
t(2, 4) = "R4C18"
t(2, 5) = "R6C18"
t(3, 1) = "４ケ月用"
t(3, 2) = "Sheet3"
t(3, 3) = "R3C20"
t(3, 4) = "R5C20"
t(3, 5) = "R7C20"
Application.ScreenUpdating = False
buf = Dir(Path & "*.xlsm")
Do While buf <> ""
For s = 1 To 3
Set sh = ThisWorkbook.Worksheets(t(s, 2))
k = sh.Range("G" & Rows.Count).End(xlUp).Row + 1
sh.Cells(k, 1) = buf
sh.Cells(k, 2) = _
ExecuteExcel4Macro("'" & Path & "[" & buf & "]" & t(s, 1) & "'!" & t(s, 3))
sh.Cells(k, 3) = _
ExecuteExcel4Macro("'" & Path & "[" & buf & "]" & t(s, 1) & "'!" & t(s, 4))
sh.Cells(k, 4) = _
ExecuteExcel4Macro("'" & Path & "[" & buf & "]" & t(s, 1) & "'!" & t(s, 5))
h = 7: j = 12
For i = 4 To 39 Step 2
sh.Cells(k, h) = _
ExecuteExcel4Macro("'" & Path & "[" & buf & "]" & t(s, 1) & "'!R" & j & "C5")
sh.Cells(k, h + 1) = _
ExecuteExcel4Macro("'" & Path & "[" & buf & "]" & t(s, 1) & "'!R" & j & "C6")
h = h + 2: j = j + 2
Next
h = 7: j = 12
For i = 40 To 75 Step 2
sh.Cells(k + 1, h) = _
ExecuteExcel4Macro("'" & Path & "[" & buf & "]" & t(s, 1) & "'!R" & j & "C7")
sh.Cells(k + 1, h + 1) = _
ExecuteExcel4Macro("'" & Path & "[" & buf & "]" & t(s, 1) & "'!R" & j & "C8")
h = h + 2: j = j + 2
Next
h = 7: j = 12
For i = 76 To 108 Step 2
sh.Cells(k + 2, h) = _
ExecuteExcel4Macro("'" & Path & "[" & buf & "]" & t(s, 1) & "'!R" & j & "C3")
If j = 18 Or j = 24 Then j = j + 1
sh.Cells(k + 2, h + 1) = _
ExecuteExcel4Macro("'" & Path & "[" & buf & "]" & t(s, 1) & "'!R" & j + 1 & "C3")
If j = 19 Or j = 25 Then j = j + 1
h = h + 2: j = j + 2
Next
h = 7: j = 12
For i = 109 To 141 Step 2
sh.Cells(k + 3, h) = _
ExecuteExcel4Macro("'" & Path & "[" & buf & "]" & t(s, 1) & "'!R" & j & "C4")
If j = 18 Or j = 24 Then j = j + 1
sh.Cells(k + 3, h + 1) = _
ExecuteExcel4Macro("'" & Path & "[" & buf & "]" & t(s, 1) & "'!R" & j + 1 & "C4")
If j = 19 Or j = 25 Then j = j + 1
h = h + 2: j = j + 2
Next
Next
buf = Dir()
Loop
Application.ScreenUpdating = True
End Sub
普通に開いて転記する方が分かりやすそうですけど。
（ウッシ） 2013/11/01(金) 16:24
これマクロでやろうとするから、面倒なんじゃないかなぁ・・・ シート上で、転記するためのセルを「＝」で繋げて、一か所に集めて、 一括貼り付けした方がよっぽど簡単じゃないですか？ （稲葉） 2013/11/01(金) 16:50
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.