ここから本文です

エクセル VBAについての質問です。 初心者です。 どうかよろしくお願いします。

hid********さん

2011/9/2617:29:58

エクセル VBAについての質問です。
初心者です。
どうかよろしくお願いします。

Sheet1とSheet2に表のデータがあります。
それぞれA列に商品名が、1の行に大きさがはいっています。
Sheet1とSheet2に重複しているデータがあり、、
Sheet1のデータ(空欄をのぞく)をSheet2に上書できるようにしたいのです。

Sheet1のデータ
__|__A__|__B__|__C__|

__|____ |__大__|__極小_|

__| りんご__|__50_|_____|

__|みかん__|_____|__0__|



Sheet2のデータ
__|__A__|__B__|__C__|__D__|__E__

__|____ |__大__|__中_ |__小__|__極小__

__| なし___|__10_|__9__|__2__|__1__

__| りんご__|__70_|__20_|__9__|__10__

__| ぶどう__|__32_|__21 _|__5__|__8__

__|みかん__|__21_|__8__|__9__|__10__

上の例であれば、
りんごの大 をSheet2の70からSheet1のデータの50に変更、
おなじく、みかん 極小 を 10から0に書き換えしたいのです。

以下は同じyahoo知恵袋で教えていただいたものです。
大きさも検索して書替られるようにしたいのですが、
どうかご教示願います。

Sub 検索更新()
Dim Rng As Range
Dim FRng As Range
Sheets("Sheet2").Activate
With Sheets("Sheet1")
For Each Rng In .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
If Not IsEmpty(Rng.Value) Then
Set FRng = Range("A:A").Find(Rng.Value, Lookat:=xlWhole)
If Not FRng Is Nothing Then
If Not IsEmpty(Rng.Offset(, 1).Value) Then _
FRng.Offset(, 1).Value = Rng.Offset(, 1).Value
If Not IsEmpty(Rng.Offset(, 2).Value) Then _
FRng.Offset(, 2).Value = Rng.Offset(, 2).Value
If Not IsEmpty(Rng.Offset(, 3).Value) Then _
FRng.Offset(, 3).Value = Rng.Offset(, 3).Value
End If
End If
Next
End With
Set FRng = Nothing
End Sub

同じような質問を重ねて申し訳ございません。
どうかよろしくお願いいたします。

補足ja7awuさんへ
返答が遅くなり大変申し訳ございません。
同じシート内で、同じサイズや商品がだぶることはございません。
説明不足ですみませんでした。
どうかよろしくお願いいたします。

閲覧数:
665
回答数:
3
お礼:
250枚

違反報告

ベストアンサーに選ばれた回答

ja7********さん

編集あり2011/9/2817:18:15

--- 全部書換え---
たぶん、こんな感じのことかと思います。
更新するデータの列数、サイズ複数設定とかを不問にしました。
つまり、見出しのサイズを検索して、その列の数値を更新するようにしました。
ちょっと、コードは複雑になります。

Sub 重複更新()
Dim Rng As Range
Dim FRng As Range
Dim FCRng As Range
Dim Col As Long
Dim MaxCol As Long
Dim Size As String
Sheets("Sheet2").Activate ' <-- 修正データ
With Sheets("Sheet1") ' <-- 基本データ
MaxCol = .Cells(1, Columns.Count).End(xlToLeft).Column
For Each Rng In .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
If Not IsEmpty(Rng.Value) Then
Set FRng = Range("A:A").Find(Rng.Value, Lookat:=xlWhole)
If Not FRng Is Nothing Then
For Col = 2 To MaxCol
If Not IsEmpty(Rng.Offset(, Col - 1).Value) Then
Size = .Cells(1, Col).Value
Set FCRng = Rows(1).Find(Size, Lookat:=xlWhole)
If Not FCRng Is Nothing Then
Cells(FRng.Row, FCRng.Column).Value = Rng.Offset(, Col - 1).Value
End If
End If
Next
End If
End If
Next
End With
MsgBox "データを更新しました。", vbInformation, "完了"
Set FCRng = Nothing
Set FRng = Nothing
End Sub

質問した人からのコメント

2011/10/1 12:11:01

成功 ありがとうございます。
感謝です。
f611さんにも感謝です。
私の説明不足にもかかわらずいろいろ考えていただいて
ありがとうございました。

ベストアンサー以外の回答

1〜2件/2件中

並び替え:回答日時の
新しい順
|古い順

hid********さん

2011/9/2814:14:16

すいません。
質問者です。
補足の補足です。

ja7awuさんへ
Sheet1とSheet2は全く同じではありません。

fmfqc611さんへ
考え方のアドバイスありがとうございます。
vbaもこのサイトの利用も初心者です。
サンプルソースをいただければ助かります。

本当に不慣れですみません。

たっくんさん

編集あり2011/9/2817:59:08

分かりました。サンプルコードの提示ということの要求ですので、以下にコードを提示します。
一部考慮が足りない部分がありましたので、修正します。
考慮が足りなかった点は、同一商品で複数のサイズに対するデータがあった場合です。
その分のループを追加しました。
Sub test2()
'検索開始行
d_start = 1
lastRow = Worksheets("sheet1").Range("A" & Rows.Count).End(xlUp).Row
A_kensu = lastRow - d_start
For i = 1 To A_kensu
strA = Worksheets("Sheet1").Cells(1 + i, 1)
'商品がセットされているコラム位置の取得
B = Worksheets("Sheet1").Cells(1 + i, 256).End(xlToLeft).Column
For j = 2 To B
'商品のアップデートすべき数値の取得
Up_cnt = Worksheets("Sheet1").Cells(1 + i, j)
If Up_cnt = "" Then
GoTo f1
End If
'商品のサイズ別データ取得
strB = Worksheets("Sheet1").Cells(1, j)

Set Obj = Worksheets("Sheet2").Cells.Find(strA)
Set Obj1 = Worksheets("Sheet2").Cells.Find(strB)
If Obj Is Nothing _
Or Obj1 Is Nothing Then
MsgBox strA & "は見つかりませんでした。"
Else
lngYLine = Obj.Row
intXLine = Obj1.Column
MsgBox strA & CStr(lngYLine) & "行目の" _
& CStr(intXLine) + "列目にあります"
If Worksheets("Sheet2").Cells(lngYLine, intXLine) >= Up_cnt Then
Worksheets("Sheet2").Cells(lngYLine, intXLine) = Up_cnt
Else
MsgBox strA & strB & "の在庫との大小関係が逆転しています。確認して下さい。"
End If
End If
f1:
Next
Next
Set Obj = Nothing
Set Obj1 = Nothing
End Sub
この記述で、どのようなレイアウトでも対応できます。
また更新するしないの判断文は在庫より、修正する値の方が大きいときエラーとして更新しないようにしていますが、ここら辺の判断についてはお任せします。
以上、確認願います。

あわせて知りたい

この質問につけられたタグ

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる