| |
▼かみちゃんへ ：
おはようございます。
帰省していたため、返信がおそくなり申し訳ありません。
ご教示いただいた方法で実際にやってみたら、思い通りの表ができました。
マクロというものは使ったことがなかったので、覚えると、とても便利ですね。
正直言って、ご教示いただいたマクロの内容は、さっぱりわかりませんが、
そのままコピー＆貼り付けをして、シート名だけ直したら、できちゃいました。
本当にありがとうございました。助かります。感謝、感謝！！
また、何か機会がありましたら、よろしくお願いいたします。
以上 みつ
>こんにちは。かみちゃん です。
>
>>2.処理開始前のシートイメージは、次のとおりです。
>> 氏名 生年月日、年齢、所属、・・・・・・・
>> 田中一郎 1970/1/1 37 管理部 ・・・・・・
>> データとしては１５０名分ほどです。
>>3.処理後のシートは、別シートを望みます。
>>4.同一部署に同一年齢の人が複数いる場合は、一人１行でもいいのですが、
>> できれば、
>> 「佐藤一郎」
>> 「鈴木一郎」
>> のように縦に並べて表示したいです。
>> 罫線は佐藤と鈴木の間には入れたくないです。
>
>Sheet1
> A B C D E
>1 氏名 生年月日、年齢 所属
>2 田中一郎 1970/1/1 37 管理部
>3 佐藤一郎 1975/2/3 32 製造部
>4 鈴木一郎 1975/3/4 32 製造部
>5
>というシートであった場合で、Sheet2に出力する場合であれば、
>以下のようなコードでできます。
>
>なお、同一部署で同一年齢の人は、セル内改行をすることで、同一
>セルで表示するようにしています。
>一人１セルにするには、面倒だったので。
>
>あと、他にもっと速くてスマートな方法があるかもしれません。
>
>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
|
|
marai
- 07/8/15(水) 6:19 -
