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


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

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

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

回答の条件
  • 1人1回まで
  • 13歳以上
  • 登録:2017/11/09 20:27:07
  • 終了:2017/11/13 21:12:05

ベストアンサー

id:yitengzongxian No.1

yitengzongxian回答回数2ベストアンサー獲得回数22017/11/11 05:33:28

ポイント700pt

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

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

他2件のコメントを見る
id: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

2017/11/13 01:44:48
id:sunfkin22

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

2017/11/13 21:11:07

その他の回答(1件)

id:yitengzongxian No.1

yitengzongxian回答回数2ベストアンサー獲得回数22017/11/11 05:33:28ここでベストアンサー

ポイント700pt

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

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

他2件のコメントを見る
id: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

2017/11/13 01:44:48
id:sunfkin22

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

2017/11/13 21:11:07
id:moviehdapp No.2

moviehdapp回答回数1ベストアンサー獲得回数02017/11/11 23:49:10

詳細をありがとう

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

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

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

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

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