"人事評価"というフォルダの中にある各エクセルファイルのB2~H2セルに入っているデータを"一覧"というエクセルに集計したくて以下のマクロを作成したのですが、固まってしまいました。


ダメな点を指摘いただけますでしょうか?

Sub 一覧作成()
Dim 人事 As Workbook
Dim 記録 As Worksheet
Dim 一覧 As Worksheet
Dim 行&, 名$, 頂$, 自$
Set 一覧 = ThisWorkbook.Worksheets(1)
一覧.Cells.Delete
一覧.Cells(1, 1) = "ファイル名"
一覧.Cells(1, 2) = "実績"
一覧.Cells(1, 3) = "管理"
一覧.Cells(1, 4) = "自己評価"
一覧.Cells(1, 5) = "他己評価"
一覧.Cells(1, 6) = "最終評価"
行 = 1
自 = ThisWorkbook.Name
頂 = デスクトップ & "\人事評価\"
名 = Dir$(頂 & "*.xls")
Do Until 名 = ""
If 名 <> 自 Then
Set 人事 = Workbooks.Open(頂 & 名)
Set 記録 = 人事.Worksheets(1)
行 = 行 + 1
一覧.Cells(行, 1) = 名
一覧.Cells(行, 2) = 記録.Cells(2, 2)
一覧.Cells(行, 3) = 記録.Cells(2, 3)
一覧.Cells(行, 4) = 記録.Cells(2, 4)
一覧.Cells(行, 5) = 記録.Cells(2, 5)
一覧.Cells(行, 6) = 記録.Cells(2, 6)
人事.Close
名 = Dir$()
End If
Loop
End Sub

回答の条件
  • 1人2回まで
  • 登録:2009/10/14 19:17:40
  • 終了:2009/10/15 13:08:47

回答(1件)

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692009/10/14 19:38:49

ポイント60pt

最後のところが

End If= Dir$()
Loop
End Sub

のようにして、「If~End」の外に「名 = Dir$()」にしないとLoopを抜けません。

id:qazu

ありがとうございます。

解決しました!!

2009/10/15 13:08:28

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません