• ベストアンサー

エクセル2003の並べ替えについて

写真のように、左側の表に入力された名前を 右側に自動で、上から詰めて表示したいのですが、可能でしょうか? 名前が増えれば(新たに入力したら)、 右側にも自動で名前が増えるようにしたいのですが・・・ よろしくお願い申し上げます

質問者が選んだベストアンサー

  • ベストアンサー
  • KURUMITO
  • ベストアンサー率42% (1835/4283)
回答No.2

E2セルに次の式を入力して下方にオートフィルドラッグします。 =IF(COUNTA(B$4:B$1000)>=ROW(A1),B4,IF(COUNTA(B$4:B$1000)+COUNTA(C$4:C$1000)<ROW(A1),"",INDIRECT("C"&ROW(A1)-COUNTA(B$4:B$1000)+3)))

ein-zwei
質問者

お礼

うまくいきました!ありがとうございました!

その他の回答 (4)

  • a987654
  • ベストアンサー率26% (112/415)
回答No.5

E2セルに =IF(COUNTA(B$4:B$8)>=ROW()-1,B4,IF(COUNTA(B$4:C$8)>=ROW()-1,OFFSET(C$4,ROW()-COUNTA(B$4:B$8)-2,0),"")) 後は下方向のえ2セルをコピー。 領域は出題に合わせましたので人数を増やす場合は B$4:B$8 と B$4:C$8 なっている部分を3か所直して下さい。

  • tom04
  • ベストアンサー率49% (2537/5117)
回答No.4

No.3です! たびたびごめんなさい。 前回の回答の数式が少し違っていました。 訂正してみてください。 Sheet1の作業用の表のC3セルに =IF(A3="","",COLUMN(A1)*10+ROW(A1)) として元データの列数分と下へずぃ~~~!とコピーします。 Sheet2のA2セルの数式はそのままで B2セルの数式を =IF(A2="","",INDEX(Sheet1!$A$3:$B$1000,MOD(A2,10),INT(A2/10))) としてみてください。 どうも何度も失礼しました。m(__)m

  • tom04
  • ベストアンサー率49% (2537/5117)
回答No.3

こんばんは! すでに回答は出ていますので・・・ 参考程度で、他の方法の一例です。 ↓の画像のようにSheet1のデータをSheet2に並び替えするようにしています。 両方のSheet共作業用の列を使わせてもらっています。 Sheet1のC3セルに =IF(A3="","",IF(COLUMN(A1)<2,ROW(A1)*10+COLUMN(A1),ROW(A1)*1000+COLUMN(A1))) という数式を入れ、列方向と行方向にオートフィルでコピーします。 Sheet2の作業列・A2セルに =IF(COUNT(Sheet1!$C$3:$D$1000)<ROW(A1),"",SMALL(Sheet1!$C$3:$D$1000,ROW(A1))) B2セルに =IF(A2="","",INDEX(Sheet1!$A$3:$B$1000,IF(INT(A2/1000)<1,INT(A2/10),INT(A2/1000)),MOD(A2,10))) という数式を入れ、A2・B2セルを範囲指定し、 B2セルのフィルハンドルで下へコピーすると 画像のような感じになります。 尚、数式は1000行まで対応できるようにしていますが、 データ量によって範囲指定の領域はアレンジしてみてください。 そして、作業用の表と列が目障りであれば非表示にしても良いかと思います。 以上、参考になれば幸いですが 他に良い方法があれば読み流してくださいね。m(__)m

  • ka_na_de
  • ベストアンサー率56% (162/286)
回答No.1

こんばんは。 一例です。 '===========シートモジュールに記述=========================== Option Explicit Private Sub Worksheet_Change(ByVal Target As Range)   Dim myLastRow As Long   Dim c As Long, r As Long, i As Long      If Target.Column = 1 Or Target.Column >= 4 Then Exit Sub      Columns("E:E").ClearContents      i = 2   For c = 2 To 3     myLastRow = Cells(Rows.Count, c).End(xlUp).Row     For r = 4 To myLastRow       If Cells(r, c).Value <> "" Then         Cells(i, "E").Value = Cells(r, c).Value         i = i + 1       End If     Next r   Next c      End Sub '==========使い方================================== 'B,C列が変化した際に自動で実行されます。

関連するQ&A