Excel VBA質問箱 IV

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

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


31207 / 76732 ←次へ | 前へ→

【50777】Re:Excel既存名簿から年齢別、所属別表を作る方法
お礼  marai  - 07/8/15(水) 6:19 -

引用なし
パスワード
   ▼かみちゃんへ :
おはようございます。
帰省していたため、返信がおそくなり申し訳ありません。
ご教示いただいた方法で実際にやってみたら、思い通りの表ができました。
マクロというものは使ったことがなかったので、覚えると、とても便利ですね。
正直言って、ご教示いただいたマクロの内容は、さっぱりわかりませんが、
そのままコピー&貼り付けをして、シート名だけ直したら、できちゃいました。
本当にありがとうございました。助かります。感謝、感謝!!
また、何か機会がありましたら、よろしくお願いいたします。
以上 みつ

>こんにちは。かみちゃん です。
>
>>2.処理開始前のシートイメージは、次のとおりです。
>> 氏名   生年月日、年齢、所属、・・・・・・・
>> 田中一郎 1970/1/1 37  管理部 ・・・・・・
>> データとしては150名分ほどです。
>>3.処理後のシートは、別シートを望みます。
>>4.同一部署に同一年齢の人が複数いる場合は、一人1行でもいいのですが、
>> できれば、
>> 「佐藤一郎」
>> 「鈴木一郎」
>> のように縦に並べて表示したいです。
>> 罫線は佐藤と鈴木の間には入れたくないです。
>
>Sheet1
>   A     B    C   D   E
>1 氏名   生年月日、年齢 所属
>2 田中一郎 1970/1/1  37 管理部
>3 佐藤一郎 1975/2/3  32 製造部
>4 鈴木一郎 1975/3/4  32 製造部
>5
>というシートであった場合で、Sheet2に出力する場合であれば、
>以下のようなコードでできます。
>
>なお、同一部署で同一年齢の人は、セル内改行をすることで、同一
>セルで表示するようにしています。
>一人1セルにするには、面倒だったので。
>
>あと、他にもっと速くてスマートな方法があるかもしれません。
>
>Sub Sample()
> Dim WS1 As Worksheet
> Dim WS2 As Worksheet
> Dim LastCell As Range
> Dim c As Range
> Dim lngRow As Long
> Dim intCol As Integer
> 
> Set WS1 = Worksheets("Sheet1")
> Set WS2 = Worksheets("Sheet2")
> Set LastCell = WS1.Cells(Rows.Count, 1).End(xlUp)
> 
> For Each c In WS1.Range("A2", LastCell)
>  lngRow = 0
>  On Error Resume Next
>  lngRow = WorksheetFunction.Match(c.Offset(, 2).Value, WS2.Columns("A"), 0)
>  On Error GoTo 0
>  If lngRow = 0 Then
>   lngRow = WS2.Cells(Rows.Count, "A").End(xlUp).Offset(1).Row
>   WS2.Cells(lngRow, "A").Value = c.Offset(, 2).Value
>  End If
>  intCol = 0
>  On Error Resume Next
>  intCol = WorksheetFunction.Match(c.Offset(, 3).Value, WS2.Rows("1"), 0)
>  On Error GoTo 0
>  If intCol = 0 Then
>   intCol = WS2.Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).Column
>   WS2.Cells(1, intCol).Value = c.Offset(, 3).Value
>  End If
>  With WS2.Cells(lngRow, intCol)
>   If .Value = "" Then
>    .Value = c.Value
>   Else
>    .Value = .Value & vbCrLf & c.Value
>   End If
>  End With
> Next
>End Sub
2 hits

【50719】Excel既存名簿から年齢別、所属別表を作る方法 marai 07/8/12(日) 22:41 質問
【50720】Re:Excel既存名簿から年齢別、所属別表を作... かみちゃん 07/8/12(日) 22:48 発言
【50724】Re:Excel既存名簿から年齢別、所属別表を作... marai 07/8/12(日) 23:38 発言
【50733】Re:Excel既存名簿から年齢別、所属別表を作... かみちゃん 07/8/13(月) 11:35 発言
【50777】Re:Excel既存名簿から年齢別、所属別表を作... marai 07/8/15(水) 6:19 お礼
【52496】Re:Excel既存名簿から年齢別、所属別表を作... marai 07/11/15(木) 19:28 質問
【52504】Re:Excel既存名簿から年齢別、所属別表を作... かみちゃん 07/11/15(木) 22:40 発言
【52519】Re:Excel既存名簿から年齢別、所属別表を作... marai 07/11/16(金) 16:11 発言
【52525】Re:Excel既存名簿から年齢別、所属別表を作... かみちゃん 07/11/17(土) 1:30 発言
【52600】Re:Excel既存名簿から年齢別、所属別表を作... marai 07/11/21(水) 5:10 発言
【52899】Re:Excel既存名簿から年齢別、所属別表を作... かみちゃん 07/12/8(土) 14:53 発言
【52902】Re:Excel既存名簿から年齢別、所属別表を作... marai 07/12/8(土) 21:16 お礼

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