• はてなアカウントでログイン
• 無料ユーザー登録

ベストアンサー

• Seven Knights2017/11/11 05:33:28

  満足700pt

  　マクロコードを書きやすいデータ配列を検討したほうがいいのかなぁ・・・
  
  　1レコード（1行）が　会員No，氏名，都道府県，情報区分，日付，個別のデータ　にするとか。

  スター

  • 

    4件のコメントを見る

  • Seven Knights 2017/11/11 10:23:18

    どうしてもと言うなら，こんな感じでどうでしょうか？
    Sub TEMP()
    Dim F As Boolean
    Set W = ActiveWorkbook
    Set SA = W.Sheets("ALL")
    CL = SA.Cells(3, 1).End(xlToRight).Column
    For i = 4 To SA.Cells(3, 4).End(xlDown).Row
    Select Case IsEmpty(SA.Cells(i, 1))
    Case True
    Case False
    Call TEMP2(W, SA.Cells(i, 3), F)
    Select Case F
    Case True
    Set SB = W.Sheets(Format(SA.Cells(i, 3)))
    RW = SB.Cells(1, 4).End(xlDown).Row + 1
    Case False
    Sheets.Add after:=SA
    Set SB = ActiveSheet
    SB.Name = SA.Cells(i, 3)
    Range(SA.Cells(3, 1), SA.Cells(3, CL)).Copy Destination:=SB.Cells(1, 1)
    RW = 2
    End Select
    Range(SA.Cells(i, 1), SA.Cells(i + 3, CL)).Copy Destination:=SB.Cells(RW, 1)
    End Select
    Next i
    End Sub
    Sub TEMP2(W, SHEETNAME, F)
    F = False
    For Each S In W.Sheets
    Select Case S.Name
    Case SHEETNAME
    F = True
    Exit For
    Case Else
    End Select
    Next
    End Sub

    スター

  • にゃんころね 2017/11/11 17:14:04

    ありがとうございます！
    仕様で、データ配列の変更ができないので質問しました。
    
    早速、実行してみて上手くいかなかったので、
    For i = 4 To SA.Cells(3, 4).End(xlDown).Row　を
    For i = i + 4 To SA.Cells(3, 4).End(xlDown).Row　
    へ修正したら分けることができました。
    
    もう一点、修正したのがありまして、４列目の小分類「情報４」などが空欄の場合でも
    分けるようにするには、どのように修正したら良いでしょうか？
    ※空欄の判定をA列、B列、C列のどれかで行いたいのです。
    
    再度、ご教示のほどお願い致します。

    スター

  • Seven Knights 2017/11/13 01:44:48

    セル結合されているのでそのようには見えないだけですが，各4行のセル結合なので行単位ごとに必ず空白セルが３つあります。なので，1列目から3列目の間で順番に行を見ていくやり方はうまく動かないと思います。それでも行のかたまりが4行単位で決まっているなら，次のような感じにするといいかもしれません。
    Sub TEMP()
    Dim FLAG As Boolean
    LABEL_ROW = 3 '会員番号，氏名，都道府県，日付，・・・のラベル行番号
    ROW_UNIT = 4 '結合する行数
    Set W = ActiveWorkbook
    Set SA = W.Sheets("ALL")
    RIGHTMOST_COLUMN = SA.Cells(LABEL_ROW, 1).End(xlToRight).Column
    For i = LABEL_ROW + 1 To SA.Cells.SpecialCells(xlCellTypeLastCell).Row Step ROW_UNIT
    Select Case IsEmpty(SA.Cells(i, 3))
    Case True
    SHEET_NAME = "都道府県未登録"
    Case False
    SHEET_NAME = Format(SA.Cells(i, 3))
    End Select
    Call TEMP2(W, SHEET_NAME, FLAG)
    Select Case FLAG
    Case True
    Set SB = W.Sheets(SHEET_NAME)
    NETHERMOST_ROW = SB.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
    Case False
    Sheets.Add after:=SA
    Set SB = ActiveSheet
    SB.Name = SHEET_NAME
    Range(SA.Cells(LABEL_ROW, 1), SA.Cells(LABEL_ROW, RIGHTMOST_COLUMN)).Copy Destination:=SB.Cells(1, 1)
    NETHERMOST_ROW = 2
    End Select
    Range(SA.Cells(i, 1), SA.Cells(i + ROW_UNIT - 1, RIGHTMOST_COLUMN)).Copy Destination:=SB.Cells(NETHERMOST_ROW, 1)
    Next i
    End Sub
    Sub TEMP2(W, SHEETNAME, FLAG)
    FLAG = False
    For Each S In W.Sheets
    Select Case S.Name
    Case SHEETNAME
    FLAG = True
    Exit For
    Case Else
    End Select
    Next
    End Sub

    スター

  • にゃんころね 2017/11/13 21:11:07

    行は、4行固定でしたので上記のコードでシート分けすることができました。ありがとうございます！

    スター

その他の回答

• moviehdapp2017/11/11 23:49:10

  0pt

  詳細をありがとう

  スター

この質問へのコメント

質問の情報

登録日時

2017-11-09 20:27:07

終了日時

2017-11-13 21:12:05

回答条件

1人1回まで

この質問のカテゴリ

• コンピュータ
• 学習・教育

この質問に含まれるキーワード

人気の質問

• 同じような体験をしたことがある人はいますか？。 ある日、お葬式の職業に就きたいなあなんて話題にしてい…匿名質問者11日前
• １９８４年から１９９０年ぐらいの間に、多分コミックボンボンに掲載されていた漫画を教えてください。 主…匿名質問者21日前
• https://hikky-mura.org/t/topic/2523/7 でsma200さんという方に戸塚ヨットスクールを勧められましたが、僕…hayakushinene13日前
• いつも大変お世話になっています。 アスペルガー精神3級独身会社員34歳男です。 最近心身共に疲れがもの凄…hayakushinene123日前
• 私の彼氏は毒親育ちで、うつ病を患い、家を追い出された後ホームレスになって、現在は何故か逮捕されて留置…匿名質問者11日前

メニュー

• 質問一覧
• カテゴリ一覧
• 無料ユーザー登録
• 人力検索はてなトップ

PC版

• お問い合わせ
• ヘルプ
• お知らせ
• はてなトップ