| |
▼Asaki さん：
ありがとうございます。
申し訳はありません。説明不足で迷惑かけて大変申し訳はありません。
実行してみたらエラー13（型が一致しません）と表示してありますが
もしかしたらシート1が氏名だけなく年齢と社員番号、性別、備考1備考2備考3が
あります。これを変換しないてこのままでコピーして以降は変換してコピーします。
シート1（データ元）
A B C D E F G H I J K L M N L O 〜 BM
氏名 社番 年齢 性別 ID 備1 備2 備3 A-1 2 3 4 5 6 7 8....65まで
ss 001 25 1 001 2 2 2 1 2 3 4 3....
si 002 23 2 002 2 1 3 2 4 2 2 3....
ai 003 20 2 003 2 3 1 3 2 1 3 3....
oh 004 50 2 004 3 2 3 3 3 2 1 1....
aa 005 33 1 005 3 2 1 3 2 3 3 1....
・
・
シート２（検査範囲用）
A BCDEFGHIJ K L M N L O P
− 12345678910111213141516〜65まで データ元の列と順番通りです。
1点333300030 3 0 3 0 0 3 3... 縦A列の1234は点数です。
2点222211121 2 1 2 1 1 2 2... B2セルは2点ならばB列にA列の2点に当てはまり
3点111122212 1 2 1 2 2 1 1... 2点なります。
4点000033303 0 3 0 3 3 0 0...
シート3（データ変換後）
A B C D E F G H I J K L M N L O 〜 BM
氏名 社番 年齢 性別 ID 備1 備2 備3 A-1 2 3 4 5 6 7 8....65まで
ss 001 25 1 001 2 2 2 3 2 2 3 1....
si 002 23 2 002 3 3 1 2 3 1 1 1....
ai 003 20 2 003 2 1 3 1 1 0 2 1....
oh 004 50 2 004 1 2 1 1 2 1 0 3....
aa 005 33 1 005 1 2 3 1 1 2 2 3....
前より詳しく説明しますのでよろしくお願いします。
・
B2セルにデータ元を読み取ってシート2の元で置換してシート3（シート３へコピー？表示？）へ表示して行が空欄するまで繰り返しします
２→シート2にVLOOKUP関数で一致したら置換してシート3へ表示します。
>Sub test()
> Dim rngOrg As Range
> Dim rngRes As Range
> Dim c As Range
> Dim i As Long
>
> '変換前データのセル範囲を変数に設定
> With Worksheets("Sheet1")
> Set rngOrg = .Range(.Cells(1, 2), .Cells(65536, 1).End(xlUp).Offset(, 16))
> End With
> '変換後データ格納セルをクリア、セル範囲を変数に設定
> '項目名コピー
> With Worksheets("Sheet3")
> Set rngRes = .Range(rngOrg.Address)
> .UsedRange.Clear
> .Cells(1, 1).Resize(rngOrg.Rows.Count).Value = rngOrg.Resize(, 1).Offset(, -1).Value
> End With
>
> '変換
> i = 1
> With Worksheets("Sheet2")
> For Each c In rngOrg
> rngRes(i).Value = .Cells(c.Value + 1, c.Column).Value
> i = i + 1
> Next c
> End With
>
> 'オブジェクト解放
> Set rngOrg = Nothing
> Set rngRes = Nothing
>
>End Sub
>
>
>ちなみに、ループは回し始めたのと逆の順に Next を書くことになります。
知らなかった。いい勉強になりました。
|
|
さる
- 04/8/23(月) 21:13 -
