アプリ版:「スタンプのみでお礼する」機能のリリースについて

下記の処理がどうしてもうまくいかなくて、
皆様のお知恵を拝借できればありがたいです。

Sheet1に下記のように縦に3列データがならんでいます。

A  あ  10
A  い  12
A  う  16
B  あ  19
B  い  15
B  う   7

これをもとにSheet2に下記の通りマトリクス形式に
変換する。

  あ  い  う
A  10  12  16
B  19  15   7

これを処理しようと以下の通り記述したのですが、
マッチする項目がなかった場合、どうも行(列)が
ずれてヒットしているようです。
On Error Resume Nextが原因のような気がするのですが。

これを回避するにはどうしたらよろしいでしょうか?
お助けください~。
よろしくお願い致します。

Dim i As Long
Dim j As Long
Dim k As Long
Dim 検索値A As Variant
Dim 検索値B As Variant
On Error Resume Next

i = 2

Do While (Sheets("SHEET1").Cells(i, 1) <> "")
検索値A = Sheets("SHEET1").Cells(i, 1).Value
検索値B = Sheets("SHEET1").Cells(i, 2).Value

j = Application.Match(検索値A, Sheets("Sheet2").Range("範囲A"), 0)
k = Application.Match(検索値B, Sheets("Sheet2").Range("範囲B"), 0)

Sheets("Sheet2").Cells(j, k).Value =Sheets("SHEET1").Cells(i, 3)

i = i + 1

Loop

End Sub

A 回答 (5件)

Cells(row,col)


のrowとcolは1からはじまります
つまり
Cells(1,1)はA1になります。
また
A,B,Cと並びがあるときMatchが返すマッチした位置も1からはじまります。
なので、(A,あ)というのをMatchで探すと(1,1)になります。
ところが、
 A B C D
1  あ い う
2A
3B
ですから
(A,あ)は、
上記でCellsでいうと(2,2)になりますから位置がずれることになります。
結局(1,1)ずれていることになるので、
Sheets("Sheet2").Cells(j+1, k+1).Value =Sheets("SHEET1").Cells(i, 3)
してやればいいような気がします
    • good
    • 0
この回答へのお礼

ご回答ありがとうございます!

説明不足でわかりにくかったと思いますが、
ご教示ありがとうございました。

参考にさせていただきます。

お礼日時:2005/07/09 13:41

こんにちは。



コードをみると、いくつか直したいところがありますね。
#1 のBLUEPIXYさんのご指摘の部分は、

最初に、データを入れる範囲を決めておいても良いと思います。

例:
同じやり方をするなら、[挿入]-[名前] -[定義]で、
 名前:"データ" ,参照範囲:Sheet2!B2:D3

このようにします。

  Sheets("Sheet2").Range("データ").Cells(j, k).Value = Sheets("SHEET1").Cells(i, 3).Value

それから、次に、

>On Error Resume Nextが原因のような気がするのですが。

On Error Resume Next でエラーを排出しても、それは、値もエラーも残ったままです。それでは、On Error の意味がありません。

そのままのコードを生かすなら、以下のように、エラー処理をします。

Do While (Sheets("SHEET1").Cells(i, 1) <> "")
  検索値A = Sheets("SHEET1").Cells(i, 1).Value
  検索値B = Sheets("SHEET1").Cells(i, 2).Value
  j = Application.Match(検索値A, Sheets("Sheet2").Range("範囲A"), 0)
  k = Application.Match(検索値B, Sheets("Sheet2").Range("範囲B"), 0)
  If Err.Number = 0 Then
  Sheets("Sheet2").Range("データ").Cells(j, k).Value = Sheets("SHEET1").Cells(i, 3).Value
  Else
  j = 0: k = 0: Err.Clear
  End If
  i = i + 1
 Loop

ただ、これは、On Error で回避するレベルのエラーではありません。Match の戻り値の宣言型の違いから出るエラーです。Match の戻り値は、見つからない場合の戻り値も吐き出しているので、本来は、On Error トラップを使わなくても、IsErrorで、戻り値を Variant にするだけで使えます。
    • good
    • 0
この回答へのお礼

ご回答ありがとうございます!

ご教示いただいたおかげで、当初の問題は解決
できました。本当に助かりました。ありがとう
ございます!

ただ、もう1つ問題が発生致しまして...
"検索値A"の一部については特定の行にデータを
セットしたいのです。その一部の"検索値A"と
いうのは例えば"aaa300"、"bbb300"等、"300"で
終わるもので、これらは特定行に固定したいという
感じです。ワイルカードを使えないものかといろいろ
調べておりますが、よくわかりません。。

たいへんドあつかましくて申し訳ございませんが、
もし目に留まりましたら、ご教示頂けましたら
幸いです。重ね重ね申し訳ありません。

お礼日時:2005/07/09 13:52

こんにちは。


既に回答は出ていますが、ちょと一言。

今回の場合、On Error Resume Nextはなかなかいい方法だと思います。
但し、あとちょっと思案すれば・・・(^^;;;

もし、提示のコードをこのまま使うとしたら
下記のように●の位置で j,k をクリアーするだけでOKです。
----------------------------------------------

Do While (Sheets("SHEET1").Cells(i, 1) <> "")
検索値A = Sheets("SHEET1").Cells(i, 1).Value
検索値B = Sheets("SHEET1").Cells(i, 2).Value

  ● j=0
  ● k=0

j = Application.Match(検索値A, Sheets("Sheet2").Range("範囲A"), 0)
k = Application.Match(検索値B, Sheets("Sheet2").Range("範囲B"), 0)
-------------------------------------------------

(理由)
例えば、データが下記のようになっていた場合

A い (該当あり)
E ら (該当なし)

該当あり「Aい」の戻り値が、j=2,k=3 となったとしますと
次の該当なし「Eら」は、MATCHでエラーとなり、
On Error Resume Nextで次の行にジャンプします。
ということは、j,kは、前の該当データ「Aい」の戻り値のままということになりますよね。
ですから、質問のようになったわけです。

もちろん、片方の値だけ該当した場合は、該当しなかった値の戻り値だけが前の戻り値のままということになります。
例えば、「Eう」 j=2(「A」の戻り値のまま),K=4(「う」の戻り値)

意図せぬ結果になったときは、本物のデータではなくて、簡単な例を使い、変数の値を一つずつ確かめてみることをお薦めします。
以上です。
    • good
    • 0
この回答へのお礼

ご丁寧な回答ありがとうございます。

コーディングをしていても、実際どういう
動きをしているのか、よくわからなかったのですが、
ご回答の内容を拝見して、イメージが沸きました。

本当にありがとうございます!

お礼日時:2005/07/09 13:56

#1です、他の方の回答を見て今さらですが


#1のような単なるズレの話ではなくマッチするものが無い場合の処理の話だと気がつきました。
勘違いコメントですみません。<(_ _>

でも、言い訳させていただくと、
もともとの表を移し替えるだけなのですから
(2重のデータが有る場合におかしくなることはあっても)
マッチしない場合があるとは考えにくいと思います
    • good
    • 0
この回答へのお礼

こちらこそ説明不足で大変申し訳ございません。

状況的にはSheet2にセットすべきデータと
もとのSheet1のデータはイコールではなく、
Sheet1にはSheet2には該当しないものが多数
含まれているという感じです。

おかげさまで当初の問題は解決致しましたが、
下にも記述したとおり、さらなる問題が
発生して、行き詰ってます(T_T)

とにかく、お世話になりありがとうございました。

お礼日時:2005/07/09 14:04

この質問はあげてある例が、不適当で、何がやりたいのか伝わらないのでは。

すでに出ている質問で解決したのかどうかもよく読めないのですが。
もし下記のような問題なら参考に。でないなら、無視してください。
A2:C10
aあ1
aう3
aえ4
bあ56
bい6
cあ7
cい8
dい45
dえ56
これを
A1:E5
あうえい
a134
b566
c78
d5645
に組み替えると解釈した。
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("sheet1")
Set sh2 = Worksheets("sheet2")
'---Sheet1の最終行
d = sh1.Range("A65536").End(xlUp).Row
'------最初行
i = 2 'sheet1
i2 = 2: j2 = 2 'sheet2
sh2.Cells(i2, "A") = sh1.Cells(i, "A")
sh2.Cells(1, "B") = sh1.Cells(i, "B")
sh2.Cells(i2, j2) = sh1.Cells(i, "C")
m = sh1.Cells(i, "A")
'-----その次行から
For i = 3 To d
If sh1.Cells(i, "A") = m Then
'前行と同じなら
r = sh2.Range("IV1").End(xlToLeft).Column 'sheet2第1行の最右列
For j = 2 To r 'sheet1のB列とsheet2の第1行で同じ列を探す
If sh2.Cells(1, j) = sh1.Cells(i, "B") Then 'Sheet2第1行とsheet1B列が等しいか
sh2.Cells(i2, j) = sh1.Cells(i, "C")
GoTo p01
End If
Next j
'j は最右列の次列をさしている
sh2.Cells(1, j) = sh1.Cells(i, "B")
sh2.Cells(i2, j) = sh1.Cells(i, "C")
p01:
Else
'前行と変わった
i2 = i2 + 1 'sheet2の次行へ進む
sh2.Cells(i2, "A") = sh1.Cells(i, "A") 'sheet2のA列セット
r = sh2.Range("IV1").End(xlToLeft).Column 'sheet2第1行の最右列
For j = 2 To r
If sh2.Cells(1, j) = sh1.Cells(i, "B") Then
sh2.Cells(i2, j) = sh1.Cells(i, "C")
GoTo p02
End If
Next j
' j は最右列の次列をさしている
sh2.Cells(1, j) = sh1.Cells(i, "B")
sh2.Cells(i2, j) = sh1.Cells(i, "C")
p02:
m = sh1.Cells(i, "A")
End If
Next i

End Sub
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!