再質問です。Excel2003重複しないデータを

質問

皆様、いつもお世話になっております。

突然のVBAの仕様変更で、困っております。
質問の題名で検索して頂けると幸いです。

やりたい事は、Excelのsheet1にDATA(データベース)が入っております。
そのDATAをsheet2の方に表示、編集(保存)するという仕様でございます。

添付データは、以前大変お世話になった方が作成されたものです。
これをベースに質問させて頂きます。

この画像は、仮にsheet2とします。DATAがが、入っているのがsheet1になります。
この画面(sheet2)で顧客Noを入力すると、sheet1のデータが表示できる仕組みです。

以前は、この画面のようにsheet1のAK列まででしたが、今回はsheet1のAU列までの
データです。列が増えるだけならいいのですが、画面のH列の3行目から12行目まで
あるデータを出力させたいのですが、そうするとAUまでsheet1の列を増やす必要が
あります。

画面で言いますとF列にsheet1というところにPから始まっているのがsheet1のデータを
出力しているということです。sheet1のP列とQ列の間にセルの挿入、次にQとRにセルを挿入
これを１０回くりかえすと、sheet1のY列とZ列にセルの挿入すると、sheet1のデータは、
AU列になります。Pから1つずつ縦にセルを挿入してYまでいきます。

その飛ばした、データを添付画像でいうとH列に10行分の表示をさせたいのですが、
全く良い案が浮かびません。

長文になり分かりづらいかと思いますが、またご協力お願いいたします。

回答No.2

wek00 · ベストアンサー

例えば、次の行はSheet2のG列に値をセットしている部分ですが、

> Cells(j, "G") = .Cells(tar.Row, "P").Offset(0, j - 3).Value

j が 3, 4, 5 ... 12 となるとき
Offsetの第2引数は j-3 なので 0, 1, 2 ... 9 となりますね。
よって、

Cells(3, "G") = .Cells(tar.Row, "P").Value
Cells(4, "G") = .Cells(tar.Row, "Q").Value
Cells(5, "G") = .Cells(tar.Row, "R").Value
　：
Cells(12, "G") = .Cells(tar.Row, "Y").Value

を実行したのと同じ結果になります。
Offsetの第2引数が 0, 2, 4 ... 18 となるように書き換えれば
P列からひとつ飛びに値を取得できます。

どうです？基本的に「何も違いはない」でしょう？
変更作業は面倒ですが。

補足

wek00さま

ご回答ありがとうございます。wek00様の言う通りにコードを変更したところ
無事、表示させる事ができました。

因みに変更した箇所は、以下のコードです。

'D列の6～17行目にSheet1(D～O列)のデータを出力
'G列の3～24行目にSheet1(P～AU列)のデータを出力
For j = 3 To 24
If tar Is Nothing Then
If 6 <= j And j <= 17 Then Cells(j, "D") = "不明"
If 3 <= j And j <= 12 Then Cells(j, "H") = "不明"
Cells(j, "G") = "不明"
Else
If 6 <= j And j <= 17 Then _
Cells(j, "D") = .Cells(tar.Row, "D").Offset(0, j - 6).Value
'Cells(j, "G") = .Cells(tar.Row, "P").Offset(0, j - 3).Value
Cells(3, "G") = .Cells(tar.Row, "P").Value
Cells(4, "G") = .Cells(tar.Row, "R").Value
Cells(5, "G") = .Cells(tar.Row, "T").Value
Cells(6, "G") = .Cells(tar.Row, "V").Value
Cells(7, "G") = .Cells(tar.Row, "X").Value
Cells(8, "G") = .Cells(tar.Row, "Z").Value
Cells(9, "G") = .Cells(tar.Row, "AB").Value
Cells(10, "G") = .Cells(tar.Row, "AD").Value
Cells(11, "G") = .Cells(tar.Row, "AF").Value
Cells(12, "G") = .Cells(tar.Row, "AH").Value
Cells(13, "G") = .Cells(tar.Row, "AJ").Value
Cells(14, "G") = .Cells(tar.Row, "AK").Value
Cells(15, "G") = .Cells(tar.Row, "AL").Value
Cells(16, "G") = .Cells(tar.Row, "AM").Value
Cells(17, "G") = .Cells(tar.Row, "AN").Value
Cells(18, "G") = .Cells(tar.Row, "AO").Value
Cells(19, "G") = .Cells(tar.Row, "AP").Value
Cells(20, "G") = .Cells(tar.Row, "AQ").Value
Cells(21, "G") = .Cells(tar.Row, "AR").Value
Cells(22, "G") = .Cells(tar.Row, "AS").Value
Cells(23, "G") = .Cells(tar.Row, "AT").Value
Cells(24, "G") = .Cells(tar.Row, "AU").Value
'H列の3～12行目にsheet1を出力
Cells(3, "H") = .Cells(tar.Row, "Q").Value
Cells(4, "H") = .Cells(tar.Row, "S").Value
Cells(5, "H") = .Cells(tar.Row, "U").Value
Cells(6, "H") = .Cells(tar.Row, "W").Value
Cells(7, "H") = .Cells(tar.Row, "Y").Value
Cells(8, "H") = .Cells(tar.Row, "AA").Value
Cells(9, "H") = .Cells(tar.Row, "AC").Value
Cells(10, "H") = .Cells(tar.Row, "AE").Value
Cells(11, "H") = .Cells(tar.Row, "AG").Value
Cells(12, "H") = .Cells(tar.Row, "AI").Value
End If
Next j
'イベントを再開
Application.EnableEvents = True

一つ問題がございまして、sheet1(データベース)の方に上書きすることができません。
下記は、私が自分で作ってみたコードですが、上手く動きません。※コメントアウトしてある行です
'▼対象とするセルがセル範囲(D10:D17)内であれば処理
Else
'検索セルが見つからなければメッセージを表示
If tar Is Nothing Then
myRng.Value = "不明"
MsgBox "対象のセルが不明です"
'検索セルが見つかればDATA Sheetの範囲D～AKで該当項目の検索行を入力値で更新
Else
Select Case myRng.Column
Case 4 'D列(列番号4)が入力された場合
.Cells(tar.Row, "H").Offset(0, myRng.Row - 10) = myRng.Value
Case 7 'G列(列番号7)が入力された場合
.Cells(tar.Row, "P").Offset(0, myRng.Row - 3) = myRng.Value
'.Cells(3, "G") = Cells(tar.Row, "P") = myRng.Value
'.Cells(4, "G") = .Cells(tar.Row, "R") = myRng.Value
'.Cells(5, "G") = .Cells(tar.Row, "T") = myRng.Value
'.Cells(6, "G") = .Cells(tar.Row, "V") = myRng.Value

.Cells(tar.Row, "P").Offset(0, myRng.Row - 3) = myRng.Value
上記をばらすと、どのようになるのでしょうか。
お手数をお掛けしますが、ご教授ください。

回答No.3

wek00

> .Cells(tar.Row, "P").Offset(0, myRng.Row - 3) = myRng.Value

myRngにはセルの場所が1セル分入れられているようですね。ばらされて。
.Rowというのは行番号を取得するメソッド、
.Valueというのは値を取得するメソッド。

例えば、R列の値が入っているセルはG5ですね。
myRngがG5なら、行番号 - 3 は 2。
Sheet1の対象行のP列のセルから0行2列offsetしたセルは、対象行のR列。
そこにG5の値を代入すれば良い。
という意図の文なんだと思います。

コメントアウトの行ですが、意図がよく分かりません。
私の自宅の現用パソコンでは LibreOffice のVBA互換モードしか
テスト環境が無いのですが、条件判断(=か)の結果を
セルに書き込む動作になりますね。

作成者や初見の人にとって分かりやすいのが一番です。だからあなたのやり方もいい方法だと思います。
> 言う通りにコードを変更した
これは心外。ループの変更忘れてるし。(T_T)

お仕事関係のようですから別ルートで対応済みかと思いますが、
一応、回答しておきます。スキルアップには自分で考えてやってみるのが一番ですし。

回答No.1

wek00

何が問題なのかよく分かりませんね．．．

Sheet2:G3:G12にP Q R ...Y 列を紐付け
を
Sheet2:G3:G12にP R T ...AH列を紐付け
Sheet2:H3:H12にQ S U ...AI列を紐付け
に変更したい、ということかと思いましたが
それなら何も違いはないし。

> H列に10行分の表示をさせたいのですが
どのような問題があってそれが出来ないのでしょう？

それと、以前の質問は以下の2つですか？
okwave.jp/qa/q8798457.html
okwave.jp/qa/q8801956.html

お礼

wek00様

お世話になっております。無事に表示させる事ができました。
wek00様ありがとうございました。

補足

wek00様

お世話になります。初めまして。分かりづらく申し訳ございません。
以前質問ささせて頂いてご教授頂きましたURLは、下記になります。

http://oshiete.goo.ne.jp/qa/8801956.html

> H列に10行分の表示をさせたいのですが
どのような問題があってそれが出来ないのでしょう？

上記の問題は、Sheet1のデータベースが、増えたのですが(以前はAIまで、今回はAUまでです)
sheet1のデータベースを単にAUまで伸ばし、sheet2のG列に表示させるのは、私でも可能なのですが、
厄介なのは、sheet1のP列から一つ飛で縦に10個セルを挿入して新たに挿入したセルは、無視して
sheet2のG列に表示させます。

1.sheet1に新たに挿入したP列から1つ飛で縦にセルを10行分挿入。その挿入したセルは、飛ばして
　sheet2のG列に表示。添付画像のままです。
2.sheet1のデータ新たにP列から1つ飛ばしで無視したセルをsheet2のH列の3行目から表示(10行分です)

以前、ご教授頂いたコードは、下記になります。

■VBAコード

'ワークシート内のセルに変更があった場合自動実行されます
'　→　変更されたセルがRange変数「Target」に代入されています
Private Sub Worksheet_Change(ByVal Target As Range)

'使用する変数の型を宣言(定義)
Dim myRng As Variant, mySt As Worksheet, tar As Range, i As Integer
Dim j As Integer
'変更されたセルの数が10個より大きい場合は終了
If Target.Count > 10 Then Exit Sub

'対象とするシートをオブジェクト変数へセット
Set mySt = Worksheets("Sheet1")

'変数Targetのセルを順次、変数myRngに格納しながら
'For～Next間をセルの数だけ繰り返し処理
For Each myRng In Target
　'With～End Withまでの省略した場合のオブジェクト(ここではSheet1)を指定
　With mySt

　　'▼対象とするセルがセル範囲(D3:D5)内であれば処理
　　If Not Application.Intersect(myRng, Range("D3:D5")) Is Nothing Then
　　　'変更されたセルの値でSheet1(の対象列)を検索して変数tarへ格納
　　　Set tar = .Columns(myRng.Row - 2).Find(myRng.Value, , xlValues, _
　　　　　xlWhole, xlByRows, xlPrevious, True, True, False)
　　　'変更されたセルの行番号を変数iに格納
　　　i = myRng.Row
　　　'イベントを無効
　　　'(セル内容の変更で自分自身が再度実行されないように無効化)
　　　Application.EnableEvents = False
　　　'Do～Loop間を繰り返し処理
　　　Do
　　　　'変数iに1を加算、iが6になれば3に変更
　　　　i = i + 1: If i = 6 Then i = 3
　　　　'iが変更された行番号になればループから抜ける
　　　　If i = myRng.Row Then Exit Do
　　　　'検索結果によって出力結果を分岐
　　　　If tar Is Nothing Then
　　　　　'検索結果が見つからなければ不明を出力
　　　　　Cells(i, "D") = "不明"
　　　　Else
　　　　　'見つかったセルと同じ行の対象項目の値を出力
　　　　　Cells(i, "D") = .Cells(tar.Row, i - 2).Value
　　　　End If
　　　Loop
　　　'D列の6～17行目にSheet1(D～O列)のデータを出力
　　　'G列の3～24行目にSheet1(P～AK列)のデータを出力
　　　For j = 3 To 24
　　　　If tar Is Nothing Then
　　　　　If 6 <= j And j <= 17 Then Cells(j, "D") = "不明"
　　　　　Cells(j, "G") = "不明"
　　　　Else
　　　　　If 6 <= j And j <= 17 Then _
　　　　　　　Cells(j, "D") = .Cells(tar.Row, "D").Offset(0, j - 6).Value
　　　　　Cells(j, "G") = .Cells(tar.Row, "P").Offset(0, j - 3).Value
　　　　End If
　　　Next j
　　　'イベントを再開
　　　Application.EnableEvents = True

　　'▼対象とするセルがセル範囲(D6:D17又はG3:G24)内であれば処理
　　ElseIf (Not Application.Intersect(myRng, Range("D6:D17")) Is Nothing) _
　　　　Or (Not Application.Intersect(myRng, Range("G3:G24")) Is Nothing) Then
　　　'検索セルtarが無い場合は検索
　　　If tar Is Nothing Then
　　　　Set tar = .Columns("A").Find(Range("D3").Value, , xlValues, _
　　　　　　xlWhole, xlByRows, xlPrevious, True, True, False)
　　　End If
　　　'対象とするセルが変更可能のセル範囲であるかの判定
　　　Application.EnableEvents = False
　　　'▼対象とするセルがセル範囲(D6:D9)内であれば処理
　　　If Not Application.Intersect(myRng, Range("D6:D9")) Is Nothing Then
　　　　'検索セルが見つからなければ不明、見つかれば値を戻して表示
　　　　If tar Is Nothing Then
　　　　　myRng.Value = "不明"
　　　　Else
　　　　　myRng.Value = .Cells(tar.Row, "D").Offset(0, myRng.Row - 6).Value
　　　　End If
　　　　'変更不可のメッセージを表示
　　　　MsgBox "対象のセル""" & myRng.Address(False, False) & """は変更できません"
　　　'▼対象とするセルがセル範囲(D10:D17)内であれば処理
　　　Else
　　　　'検索セルが見つからなければメッセージを表示
　　　　If tar Is Nothing Then
　　　　　myRng.Value = "不明"
　　　　　MsgBox "対象のセルが不明です"
　　　　'検索セルが見つかればSheet1の範囲D～AKで該当項目の検索行を入力値で更新
　　　　Else
　　　　　Select Case myRng.Column
　　　　　　Case 4　'D列(列番号4)が入力された場合
　　　　　　　.Cells(tar.Row, "H").Offset(0, myRng.Row - 10) = myRng.Value
　　　　　　Case 7　'G列(列番号7)が入力された場合
　　　　　　　.Cells(tar.Row, "P").Offset(0, myRng.Row - 3) = myRng.Value
　　　　　End Select
　　　　End If
　　　End If
　　　Application.EnableEvents = True
　　End If

　End With
Next
End Sub

説明が上手くなく申し訳ございません。お手すきの時で構いませんので
ご回答お願い致します。よろしくお願いいたします。