電子書籍の厳選無料作品が豊富!

【やりたい内容】
1)元データのA列5行目~C列14行目の表から、3)結果(やりたい結果)のように、
名前(重複あり)が交差するセルに、日付と名前と数量のデータを入力したいので、
2-2)VBAプログラムを作成し実行するのですが、結果が、2-1)結果となります。
【質問】
以下の①②が上手く行きませんので、何方か教えて頂けないでしょうか!
VBA初心者ですので、宜しくお願いします。
又は、他の手法のプログラムで良い方法が有りましたら、ご指導お願いします。
① 行の名前が複数ある場合の記述方法が分かりません。(列の名前は複数無し)
② 行に名前(メロン)が有るのですが、列に名前が無い場合は、記入無しにしたい。

1)元データ
  A列  B列   C列
5行 日付 名前 数量
6行  5/1  みかん 750
7行  5/2 りんご 300
8行  5/2 いちご 900
9行  5/3 すいか 850
10行 5/5 いちご 700
11行 5/6 みかん 1200
12行 5/7 いちご 1200
13行 5/10 メロン 1500
14行 5/15 すいか 1200

2-1)結果
   D列 E列 F列 G列 H列 I列 J列 K列 L列 M列 N列 O列 P列 Q列 R列 S列
2行 みかん りんご いちご すいか
5行 日付 数量 状況 名前 日付 数量 状況 名前 日付 数量 状況 名前 日付 数量 状況 名前
6行 5/1 1200    みかん
7行             5/2 300   りんご
8行                       5/2 1200   いちご
9行                                  5/3 1200  すいか
10行
11行
12行
13行  5/10 1500   メロン
14行

2-2)VBAプログラム
Sub クロス入力()
Dim i, k, TgRow, TgCol As Long
MaxRow = Cells(Rows.Count, 2).End(xlUp).Row '最終行の取得
MaxCol = Cells(2, Columns.Count).End(xlToLeft).Column '最終列の取得
'データ削除
If MaxRow > 5 Then
Range(Cells(6, "D"), Cells(MaxRow, MaxCol)).ClearContents
End If
'データ抽出
For Each k In Range("B6:B" & MaxRow)
For i = 6 To MaxRow
If Cells(i, 2) = k Then
TgRow = i
Exit For
End If
Next i
For i = 4 To MaxCol
If Cells(2, i) = k Then
TgCol = AAi
Exit For
End If
Next i
'データ出力
Cells(TgRow, TgCol).Value = k.Offset(0, -1).Value
Cells(TgRow, TgCol).Offset(0, 3).Value = k.Value
Cells(TgRow, TgCol).Offset(0, 1).Value = k.Offset(0, 1).Value
Next k
End Sub

3)結果 (やりたい結果)
   D列 E列 F列 G列 H列 I列 J列 K列 L列 M列 N列 O列 P列 Q列 R列 S列
2行 みかん りんご いちご すいか
5行 日付 数量 状況 名前 日付 数量 状況 名前 日付 数量 状況 名前 日付 数量 状況 名前
6行 5/1 750 みかん
7行             5/2 300   りんご
8行                       5/2 900   いちご
9行                                  5/3 850  すいか
10行                      5/5 700   いちご
11行 5/6 1200  みかん
12行                      5/7 1200  いちご
13行
14行                                 5/15 1200  すいか

A 回答 (3件)

回答ではありません。



メロンにつきましてはこのように説明が書かれてます。

>② 行に名前(メロン)が有るのですが、列に名前が無い場合は、記入無しにしたい。

失礼しました。
    • good
    • 0

補足要求です。


1.メロンが結果(やりたい結果)にありませんが、それは意図した結果でしょうか。
2.結果(やりたい結果)をNo1の方のように画像で添付していただけませんでしょうか。
    • good
    • 0

こんにちは



せっかくのご説明ですが、ずれているので表がどうなっているのかよくわかりません。
ですので、勝手に妄想してみました。
(妄想なので、当たるも八卦です。)

>① 行の名前が複数ある場合の記述方法が分かりません。
元データで名前が複数あるとは思えませんが、同じ行に表示すれば良いということではないのでしょうか?
(違っている場合は、ハズレですので、以下は無視してください)
>② 行に名前(メロン)が有るのですが、~~
2行目と照合すれば良さそうに思います。


以下は、ご提示の考え方とはまったく異なる方法ですが(どうせ妄想ですので)、実行すると結果は添付図のようになります。
(なさりたいことと一致しているのかどうかは、当方にはわかりません。)
※ とりあえず、D2:G2の範囲は固定にしてあります。

Sub Q12993113()
Dim rw As Long
Const f1 = "=IFERROR(IF(MATCH($B6,$D$2:$G$2,0)*4=INT"
Const f2 = "(COLUMN()/4)*4,INDEX($A6:$C6,CHOOSE"
Const f3 = "(MOD(COLUMN(),4)+1,1,3,0,2)),""""),"""")"

rw = Cells(Rows.Count, 1).End(xlUp).Row
If rw < 6 Then Exit Sub
With Range("D6:S6").Resize(rw - 5)
.FormulaLocal = f1 & f2 & f3
.Value = .Value
End With
End Sub
「列と行の名前(重複あり)が交差するセルに」の回答画像1
    • good
    • 5

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

このQ&Aを見た人はこんなQ&Aも見ています