人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

Excelのシート分け。結合セルがある表を、ある項目ごとにシート分けをする方法をご伝授ください。

ALLというシートがあり、A列:会員No、B列:氏名、C列:都道府県とあり、各4行で結合してあります。
各データは、名簿一覧シートから参照して、A列、B列、C列は埋まっています。
名簿一覧で、データの追加、削除されると、自動的にALLのシートも更新をされます。
また、D列以降は、一行ごとに個別のデータが入っています。

このALLシートを、C列の都道府県ごとにシート分けをするマクロを作成していますが上手くいきません。

都道府県ごとにシート分けをしシート名は都道府県名で作成のマクロに関して、ご伝授のほど
よろしくお願い致します。



1510226827
●拡大する

●質問者: にゃんころね
●カテゴリ:コンピュータ 学習・教育
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● yitengzongxian
●700ポイント ベストアンサー

マクロコードを書きやすいデータ配列を検討したほうがいいのかなぁ・・・

1レコード(1行)が 会員No,氏名,都道府県,情報区分,日付,個別のデータ にするとか。


yitengzongxianさんのコメント
どうしてもと言うなら,こんな感じでどうでしょうか? 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

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

yitengzongxianさんのコメント
セル結合されているのでそのようには見えないだけですが,各4行のセル結合なので行単位ごとに必ず空白セルが3つあります。なので,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

にゃんころねさんのコメント
行は、4行固定でしたので上記のコードでシート分けすることができました。ありがとうございます!

2 ● moviehdapp
●0ポイント

詳細をありがとう

関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ