| |
▼chii さん：
>初めまして。
>（1）sheet1のＡ列をキーとし、キーの一致するデータを1行にまとめて
>（2）sheet2の結果のようにしたいのですが、どのようにすれば
>いいのでしょうか？ご教授ください。
>よろしくお願いいたします。
>
>
ちんといいます。横から失礼します。
セルが空欄なら、処理終了の手法を取って、いけば汎用性があると思うので、
空欄なら、Exit ForでFor文をぬけるように作ってみました。
Dim i As Long
Dim Old_a1 As String '*** ＯＬＤキー
Dim A1_St1 As Long '*** データ読み込み開始位置
Dim A1_Et1 As Long '*** データ読み込み終了位置
Dim j As Integer, j1 As Integer, s1 As Integer, s2 As Integer
Old_a1 = ""
s1 = 0 '<--- Sheet2へのセットを開始する行
s2 = 0 '<--- Sheet2へのセットを開始する列
For i = 1 To 65536
If Sheet1.Cells(i, 1) = "" Then '<-- 空欄ならデータ無しと判断する
Exit For
End If
If Old_a1 <> Sheet1.Cells(i, 1) Then
If Old_a1 = "" Then '<-- 最初のみ
A1_St1 = i '<-- 同一データの開始位置をセット
A1_Et1 = i '<-- 同一データの終了位置をセット
Old_a1 = Sheet1.Cells(i, 1) '<--- キーの保存
Else
A1_Et1 = i - 1 '<-- 同一データの終了位置をセット
Old_a1 = Sheet1.Cells(i, 1) '<--- キーの保存
GoSub Sheet2_SET '<--- シート２へデータセット
A1_St1 = i '<-- 同一データの開始位置をセット
A1_Et1 = i '<-- 同一データの終了位置をセット
End If
End If
Next i
'**** 最後のデータをセットする。
If Old_a1 <> "" Then
GoSub Sheet2_SET '<--- シート２へデータセット
End If
Exit Sub
Sheet2_SET:
'**** シート１のデータをシート２へデータセット
s1 = s1 + 1 '<--- Sheet2のデータセットする行
s2 = 0 '<--- Sheet2のデータセットする列
For j1 = 1 To 256 'Ａ列〜ＩＶ列まで
If Sheet1.Cells(A1_St1, j1).Value = "" Then '*** 空欄ならデータなし
Exit For
End If
For j = A1_St1 To A1_Et1
s2 = s2 + 1
Sheet2.Cells(s1, s2).Value = Sheet1.Cells(j, j1).Value
If s2 = 1 Then '*** Ａ列のデータは１回セットでおしまい。
Exit For
End If
Next j
Next j1
Return
こんな感じでしょうか？参考までに・・・
|
|
ちん
- 04/1/15(木) 13:52 -
