1188186915 ≪EXCEL VBA≫


エクセルのシートにA列の氏名でソートされたデータが入っています。
これをA列のデータごとに新規ファイルで保存することはできますか?
(ファイル名はA列.xls)

保存する形式はcsvでもかまいません。

語彙不足で状況がうまく説明できないので、画像を見て雰囲気をつかんでいただけたら嬉しいです。

コメント欄も開いておきます。
よろしくお願いします。

回答の条件
  • 1人2回まで
  • 登録:2007/08/27 12:55:16
  • 終了:2007/08/27 22:34:44

ベストアンサー

id:taknt No.1

きゃづみぃ回答回数13539ベストアンサー獲得回数11982007/08/27 13:55:01

ポイント60pt
Sub Macro1()
    
b = ""
c = 2
Sheets("Sheet1").Select
Sheets("Sheet1").Range("A1").Select
Selection.End(xlDown).Select
d = Selection.Row

For a = 2 To d
    If Sheets("Sheet1").Range("A" & a) = "" Then Exit For
        
    If b <> Sheets("Sheet1").Range("A" & a) Then
        b = Sheets("Sheet1").Range("A" & a)
        c = a - 1
        Sheets("Sheet1").Select
        Sheets("Sheet1").Copy After:=Sheets(1)
        ActiveSheet.Name = "worksheet"

        For a2 = d To 2 Step -1
            If b = Sheets("Sheet1").Range("A" & a2) Then
                c2 = a2 + 1
                Exit For
            End If
        Next a2

        If d >= c2 Then
            Sheets("worksheet").Rows(c2 & ":" & d).Select
            Selection.Delete Shift:=xlUp
        End If

        If 2 < c Then
            Sheets("worksheet").Rows("2:" & c).Select
            Selection.Delete Shift:=xlUp
        End If
        

        Sheets("worksheet").Select
        Sheets("worksheet").Move
         
        ActiveWorkbook.SaveAs Filename:=b & ".xls"
        ActiveWorkbook.Close
    End If
Next a
End Sub

実行させる条件として 氏名のエクセルファイルが存在しないこと。

元のシート名は Sheet1

ワークとして worksheet のシート名が利用できること。

id:panana

希望通りの動作をしました!

どんな処理をしているのか、これから読み解こうと思います。

ありがとうございました。とても助かりました。

2007/08/27 14:10:17
  • id:Kotobuki_F
    画像程度のデータ数なら手動でやってしまう方が速いですけど
    実際はどれぐらいのデータがあるんでしょう?
  • id:panana
    コメントありがとうございます。
    8000~15000行くらいで、AAA、BBB…といった人の名前は700~800人です。
    最終的に人別のExcelかCSVができれば、使用するのはAccessでもかまいません。
  • id:taknt
    そういや、コメントなしのプログラムでした。

    処理の内容ですが、元のシート Sheet1 を コピーして worksheet という名前にします。

    処理対象の氏名の人の行だけ残して、ほかの行を削除します。

    その worksheet を 新しいブックに移動させます。
    その新しいブックは、処理対象の氏名の人の名前で保存して 閉じます。

    次の人に処理を 移行します。

    なければ 終了です。
  • id:taknt
    ループ数を変更したので
    If Sheets("Sheet1").Range("A" & a) = "" Then Exit For
    は 不要になりました。

    今、ソースみてて気がつきました。

    あと流れで不明な点は ありますでしょうか?
  • id:panana
    コメントありがとうございます。
    大きな流れは大体理解しました。
    あとは根本的なところで知らないプロパティやメソッドがたくさんあるので、
    一文一文英文を訳すように、じっくり追って行きたいと思います。

    ありがとうございました。

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

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

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

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