Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


8788 / 76732 ←次へ | 前へ→

【73512】コードを整理したい
質問  たろう  - 13/1/17(木) 11:45 -

引用なし
パスワード
   先週Excel4.0マクロの件でお世話になった者です。
中身は見れたもののコードの作りが今と違うのでさっぱり意味がわからず
結局自作しようということになったのですが行き詰まってしまったので
何かいい方法がないかと質問させてもらうことにしました。

一覧表から家系図のような表に変換するマクロを
作っているのですが、あまりにもコードが長くなるばかりで拡張性もなく
整理したいのですが何かいい方法はないでしょうか。

今作っているのは

1 A
2 B
1 C
2 D
3 E
2 F

みたいに1〜3に当てはめられたデータを下のように

1  2 3
A B 
C D E
  F

と列ごとに並び替えるマクロなんですが、
自分が作ったコードだとこれに4列目、5列目と増えることになると
肥大するばかりでなにがなんだかわからない状況になってしまいます。
これをもっとすっきり何列増えても対応するようなコードに整理したい
のですが何かいい方法はないでしょうか??

説明がうまくできてないと思うのでここまで作ったコードを乗せておきます。
1〜3までならこのコードでうまくいきます。

A列に1〜3の数字を入れると機能します。

  Dim i As Integer, u As Integer
  i = 2
  u = 8
  Do While Cells(i, 1).Value <> ""
    If Cells(i, 1).Value - Cells(i - 1, 1).Value = 0 Then
      If Cells(i, 1).Value = 1 Then
      Range(Cells(u + 1, 4), Cells(u + 6, 4)).Borders(xlEdgeBottom).LineStyle = xlContinuous
      Range(Cells(u + 1, 4), Cells(u + 6, 4)).Borders(xlEdgeLeft).LineStyle = xlContinuous
      Range(Cells(u + 6, 5), Cells(u + 10, 5)).BorderAround LineStyle:=xlContinuous
      Cells(u + 6, 5).Value = Cells(i, 1).Value
      ElseIf Cells(i, 1).Value = 2 Then
      Range(Cells(u + 1, 4), Cells(u + 6, 4)).Borders(xlEdgeLeft).LineStyle = xlContinuous
      Range(Cells(u + 1, 7), Cells(u + 6, 7)).Borders(xlEdgeBottom).LineStyle = xlContinuous
      Range(Cells(u + 1, 7), Cells(u + 6, 7)).Borders(xlEdgeLeft).LineStyle = xlContinuous
      Range(Cells(u + 6, 8), Cells(u + 10, 8)).BorderAround LineStyle:=xlContinuous
      Cells(u + 6, 8).Value = Cells(i, 1).Value
      ElseIf Cells(i, 1).Value = 3 Then
      Range(Cells(u + 1, 4), Cells(u + 6, 4)).Borders(xlEdgeLeft).LineStyle = xlContinuous
      Range(Cells(u + 1, 7), Cells(u + 6, 7)).Borders(xlEdgeLeft).LineStyle = xlContinuous
      Range(Cells(u + 1, 10), Cells(u + 6, 10)).Borders(xlEdgeBottom).LineStyle = xlContinuous
      Range(Cells(u + 1, 10), Cells(u + 6, 10)).Borders(xlEdgeLeft).LineStyle = xlContinuous
      Range(Cells(u + 6, 11), Cells(u + 10, 11)).BorderAround LineStyle:=xlContinuous
      Cells(u + 6, 11).Value = Cells(i, 1).Value
      End If
      u = u + 6
    ElseIf Cells(i, 1).Value - Cells(i - 1, 1).Value = 1 Then
      If Cells(i, 1).Value = 2 Then
      Range(Cells(u, 6), Cells(u, 7)).Borders(xlEdgeBottom).LineStyle = xlContinuous
      Range(Cells(u, 8), Cells(u + 4, 8)).BorderAround LineStyle:=xlContinuous
      Cells(u, 8).Value = Cells(i, 1).Value
      ElseIf Cells(i, 1).Value = 3 Then
      Range(Cells(u, 9), Cells(u, 10)).Borders(xlEdgeBottom).LineStyle = xlContinuous
      Range(Cells(u, 11), Cells(u + 4, 11)).BorderAround LineStyle:=xlContinuous
      Cells(u, 11).Value = Cells(i, 1).Value
      End If
    ElseIf Cells(i, 1).Value - Cells(i - 1, 1).Value = -1 Then
      If Cells(i, 1).Value = 1 Then
      Range(Cells(u + 1, 4), Cells(u + 6, 4)).Borders(xlEdgeBottom).LineStyle = xlContinuous
      Range(Cells(u + 1, 4), Cells(u + 6, 4)).Borders(xlEdgeLeft).LineStyle = xlContinuous
      Range(Cells(u + 6, 5), Cells(u + 10, 5)).BorderAround LineStyle:=xlContinuous
      Cells(u + 6, 5).Value = Cells(i, 1).Value
      ElseIf Cells(i, 1).Value = 2 Then
      Range(Cells(u + 1, 4), Cells(u + 6, 4)).Borders(xlEdgeLeft).LineStyle = xlContinuous
      Range(Cells(u + 1, 7), Cells(u + 6, 7)).Borders(xlEdgeBottom).LineStyle = xlContinuous
      Range(Cells(u + 1, 7), Cells(u + 6, 7)).Borders(xlEdgeLeft).LineStyle = xlContinuous
      Range(Cells(u + 6, 8), Cells(u + 10, 8)).BorderAround LineStyle:=xlContinuous
      Cells(u + 6, 8).Value = Cells(i, 1).Value
      End If
      u = u + 6
    ElseIf Cells(i, 1).Value - Cells(i - 1, 1).Value = -2 Then
      If Cells(u, 8).Value = "" Then
      Range(Cells(u + 1, 6), Cells(u + 1, 7)).AutoFill Destination:=Range(Cells(u - 5, 6), Cells(u + 1, 7)), Type:=xlFillDefault
      End If
      Range(Cells(u + 1, 4), Cells(u + 6, 4)).Borders(xlEdgeBottom).LineStyle = xlContinuous
      Range(Cells(u + 1, 4), Cells(u + 6, 4)).Borders(xlEdgeLeft).LineStyle = xlContinuous
      Range(Cells(u + 6, 5), Cells(u + 10, 5)).BorderAround LineStyle:=xlContinuous
      Cells(u + 6, 5).Value = Cells(i, 1).Value
      u = u + 6
    End If
    i = i + 1
  Loop
  ActiveCell.Offset(1, 0).Select

277 hits

【73512】コードを整理したい たろう 13/1/17(木) 11:45 質問
【73513】Re:コードを整理したい UO3 13/1/17(木) 12:14 発言
【73514】Re:コードを整理したい UO3 13/1/17(木) 12:20 発言
【73516】Re:コードを整理したい たろう 13/1/17(木) 15:29 発言
【73517】Re:コードを整理したい UO3 13/1/17(木) 16:01 発言
【73518】Re:コードを整理したい たろう 13/1/17(木) 16:24 発言
【73519】Re:コードを整理したい UO3 13/1/17(木) 19:53 発言
【73520】Re:コードを整理したい UO3 13/1/17(木) 20:30 発言
【73527】Re:コードを整理したい たろう 13/1/18(金) 10:38 発言
【73528】Re:コードを整理したい UO3 13/1/18(金) 10:46 発言
【73529】Re:コードを整理したい たろう 13/1/18(金) 11:07 発言
【73530】Re:コードを整理したい UO3 13/1/18(金) 14:37 発言
【73557】Re:コードを整理したい たろう 13/1/21(月) 10:22 お礼

8788 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free