こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

再質問です。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にセルを挿入
これを10回くりかえすと、sheet1のY列とZ列にセルの挿入すると、sheet1のデータは、
AU列になります。Pから1つずつ縦にセルを挿入してYまでいきます。

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

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

投稿日時 - 2014-11-14 20:50:55

QNo.8825188

すぐに回答ほしいです

質問者が選んだベストアンサー

例えば、次の行は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列からひとつ飛びに値を取得できます。

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

投稿日時 - 2014-11-16 21:21:16

補足

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
上記をばらすと、どのようになるのでしょうか。
お手数をお掛けしますが、ご教授ください。

投稿日時 - 2014-11-18 19:47:52

ANo.2

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.3

> .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)

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

投稿日時 - 2014-11-22 19:13:06

ANo.1

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

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

投稿日時 - 2014-11-16 11:35:53

補足

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

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

投稿日時 - 2014-11-16 19:36:22

お礼

wek00様

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

投稿日時 - 2014-11-20 19:40:41

あなたにオススメの質問