VBA特定セルの値により、他のセルの値を変更する

質問

いつもお世話になっております。
以下のような表で・・・
　　　　　 {A}　　　　 {B} 　{C} 　　{D} 　　{E} 　　{F} 　　　{G}　　　　{H} 　　　{I}　　　{J}　　　　{K}
{1} 氏名　　住所　　電話　　　1月　　　3月　　　7月　　　10月　　　処理(1)　処理(2)　処理(3)　処理(4)　

{2} A　　　　　XXX 　000-00 　(1) 　　(2)　　　(3)　　　　(4)　　　1月　　　3月　　　7月　　10月
{3} B 　TTT　　　　000-0 　空白　　　(1)　　　　(1)　　　　空白　　3月　　　空白　　　空白　　空白
{4} C 　GGG　　　　010　　　空白　　　(3)　　　　(4)　　　　空白　　空白　　 空白 3月　　7月

A～Cには氏名・住所・電話　がはいっており、D～Gには月がはいっており、H～Kには処理の名前が入っています。1行目は見出しです。
（H列以降、処理は増える可能性あり。）

マクロで、（H2:KのlastRow = Cells(65536, "A").End(xlUp).Row）までに、その処理が何月に行われたかを入れたいのですが、
DEFGが(1)－(2)－(3)－(4)　の場合、HIJK　には1月-3月-7月-10月と入り、
DEFGが□－(1)－□－□　の場合、HIJK　には3月－□－□－□と入り、
DEFGが□－(2)－□－□　の場合、HIJK　には□－3月－□－□と入り、
DEFGが□－□－(4)－(4)　の場合、HIJK　には□－□－7月－□と入るようにマクロを組みたいのです。
（□は空白です。）
自分でも何度も組んでいるのですがエラーも出ずで、まったく動かず・・・
どなたかご教授ください。おねがいします！！！

回答No.1

redfox63 · ベストアンサー

やりたいことがいまいち不明瞭なのですが …
DEFGのセル位置とデータの関係をはっきりさせましょう
1) DEFGの各列に対応してHIJKにデータを転記するなのか
2) DEFGの各セルのデータに応じてHIJK列にデータを転記するなのでしょうか

たぶん2)なのでしょうね
でも 2)だとすると4番目の『□－□－(4)－(4)』パターンの場合
□－□－7月－□なるのが理解に苦しむところです
4番目が『□－□－(3)－(4)』で□－□－7月－10月 とか
4番目が『□－□－(4)－(4)』で□－□－□－7月 または □－□－□－－10月とか
ならわかるのですが …

サンプルマクロ
Sub Macro1( oSr as Range, oDe as Range)
dim arSrc as Variant, arDes as Variant
dim n as integer
dim arData(1 to4) as String
' Range("D2:G2")などを取得
arSrc = oSr.Value
' Range("H2:K2")などを取得
arDes = oDe.Value
arData(1) = "1月"
arData(2) = "3月"
arData(3) = "7月"
arData(4) = "10月"
for n = 1 to 4
　　select case arSrc(1,n)
　　case "(1)"
　　　　' 処理1に転記
　　　　arDes(1,1) = arData(n)
　　case "(2)"
　　　　' 処理2に転記
　　　　arDes(1,2) = arData(n)
　　case "(3)"
　　　　' 処理3に転記
　　　　arDes(1,3) = arData(n)
　　case "(4)"
　　　　' 処理4に転記
　　　　arDes(1,4) = arData(n)
　　next
oDe.value = arDes
End Sub

といった具合でいかがでしょう
これは1行分の処理なので これをループで回してやればいいと思います
呼び出し側で
Dim oSrc as range, oDes as Range
dim n as integer
Set oSrc = Range("D2:G2")
Set oDes = Range("H2:K2")
for n = 2 to Range("A65536").End(xlUp).Row
　　macro1 oSrc, oDes
　　' 次の行を設定する
　　Set oSrc = oSrc.Offset(1)
　　Set oDes = oDes.Offset(1)
next
といった具合です

お礼

For n = 4 To 1 Step -1
にしたら思い通りの形になりました。
お早いご回答に感謝します。ありがとうございました。

補足

ご回答ありがとうございます。
>たぶん2)なのでしょうね
でも 2)だとすると4番目の『□－□－(4)－(4)』パターンの場合
□－□－7月－□なるのが理解に苦しむところです
4番目が『□－□－(3)－(4)』で□－□－7月－10月 とか
4番目が『□－□－(4)－(4)』で□－□－□－7月 または □－□－□－－10月とか

処理を最初に始めた月はいつかを転記したいので、
(1)－(1)－(1)－(1)では、1月-□-□-□
となるようにしたいのです。
□－□ー(3)－(4)では□-□-7月-10月
□－□－(4)－(4)では□－□－□-7月
となります。

回答No.5

end-u

別に関数に拘るわけではないですが
Sub try()
　　Dim t As Single

　　t = Timer
　　With Range("A1").CurrentRegion
　　　　With Intersect(.Cells, .Offset(1, 7))
　　　　　　.Formula = "=IF(COUNTIF($D2:$G2,H$1),INDEX($D$1:$G$1,MATCH(H$1,$D2:$G2,0)),"""")"
　　　　　　.Copy
　　　　　　.PasteSpecial xlPasteValues
　　　　　　Application.CutCopyMode = False
　　　　End With
　　End With
　　Debug.Print Timer - t
End Sub

処理種100×10,000行で、私の非力なPCでも12～13secです。
これで許容範囲なら、簡便さ考慮してこの辺で妥協という事もありかもしれません。

データ量がもっと多くなると、配列使用が良いでしょう。
コード内容を理解しないとメンテナンスが大変かも。

『H1以降に処理の名前だけを入れるようにする』条件は変わらず。
Sub try2()
　　Dim v, w, x
　　Dim i As Long
　　Dim j As Long
　　Dim t As Single

　　t = Timer
　　With Range("A1").CurrentRegion
　　　　With Intersect(.Cells, .Offset(, 3))
　　　　　　v = .Value
　　　　　　x = .Rows(1).Value
　　　　　　For i = 2 To UBound(v)
　　　　　　　　For j = 4 To 1 Step -1
　　　　　　　　　　If Not IsEmpty(v(i, j)) Then
　　　　　　　　　　　　w = Application.Match(v(i, j), x, 0)
　　　　　　　　　　　　If Not IsError(w) Then
　　　　　　　　　　　　　　v(i, w) = v(1, j)
　　　　　　　　　　　　End If
　　　　　　　　　　End If
　　　　　　　　Next
　　　　　　Next
　　　　　　.ClearContents
　　　　　　.Value = v
　　　　End With
　　End With
　　Debug.Print Timer - t
End Sub

#ダブリ判定せず上書きなのでちょっと手抜き。（でも結果は正しく出るはず）

お礼

ありがとうございます。
またまたend-u様の素敵なコード・・。
いつもコードのスマートさに感動させられます。
配列はまだまだ私にはどーしても理解し難いものですが。（＾＾；）
勉強ガンバリます！！

回答No.4

noname#70958

私もつい関数でやりたくなっちゃいますが…。

'-------------------↓　ココカラ　↓-------------------
Sub Sample()
　For i = 2 To Cells(65536, "A").End(xlUp).Row
　　For j = 1 To 4
　　　myStr = "(" & j & ")"
　　　For k = 1 To 4
　　　　If Cells(i, 3 + k) = myStr Then
　　　　　Cells(i, 7 + j) = Choose(k, 1, 3, 7, 10) & "月"
　　　　　Exit For
　　　　End If
　　　Next k
　　Next j
　Next i
End Sub
'-------------------↑　ココマデ　↑-------------------

ループi：行の数だけ回す
ループj：処理の数【(1)～(4)の4種類】だけ回す
ループk：時期の数【1月,3月,7月,10月の4種類】だけ回す

いろいろ端折ってるのでコーディングは参考にしない方がよいかもしれません。

ex.
(1)-(2)-(3)-(4)　⇒　1月-3月-7月-10月
□-(1)-(1)-□　⇒　3月-□-□-□
□-(3)-(4)-□　⇒　□-□-3月-7月
□-(1)-□-□　⇒　3月-□-□-□
□-(2)-□-□　⇒　□-3月-□-□
□-□-(4)-(4)　⇒　□-□-□-7月
□-□-(3)-(4)　⇒　□-□-7月-10月
(1)-(1)-(1)-(1)　⇒　1月-□-□-□

以上ご参考まで。

お礼

ありがとうございます。
コードって本当に色々ありますね・・・。
すごく勉強になります。

回答No.3

end-u

ご質問の意味を勘違いしていなければ、
H1:K1に (1),(2),(3),(4)...などと、処理の名前だけを入れるようにし、
D:G列にも処理名だけがはいっているなら、一般関数で処理できそうですね。
#データ量が多くなければ、ですが。

With Range("H2", Range("A65536").End(xlUp).Offset(, 10))
　　.Formula = "=INDEX($D$1:$G$1,MATCH(H$1,$D2:$G2,0))"
　　.Value = .Value
　　.Replace "#N/A", ""
End With

もしくは
With Range("H2", Range("A65536").End(xlUp).Offset(, 10))
　　.Formula = "=IF(COUNTIF($D2:$G2,H$1),INDEX($D$1:$G$1,MATCH(H$1,$D2:$G2,0)),"""")"
　　.Value = .Value
End With

補足

いつもありがとうございます。
関数も考えたのですが、
データ量が多いので、関数ではないやり方でやりたいのです・・。
また処理の種類もK列以降に増える可能性があります。

回答No.2

imogasi

質問の書き方がわかり難い。
VBAでやるようだが、VBA的に難しい点（小ロジックで）というのは、どういう点にあると思いますか。文章で表現するとどうなりますか。
ーー
実例を挙げ方が、データだけ示すと、読者には、わかり難い場合が多い。
（ただプログラムで回答するには具体的にセル番地がわかる必要があるが。）
＞DEFGが(1)－(2)－(3)－(4)　の場合
この特徴を「文章で表現する」とどうなりますか。
＞特定セルの値により、
以って回った表現だが、「具体的にセル番地で言い、文章で表現するとどうなりますか」特定セルは１つではないようだが。
＝＝＝＝＝＝推定表現
DEFG列で、もし文字が入っていると、その列の第１行目の月数を見て、
処理(1)　処理(2)　処理(3)　処理(4）の対応列に見出しの月数を入れる。
＝＝＝推定例
例データ
D1:J8
D列ーJ列
ーは（左詰め表示されないための）便宜上空白を示す。
１月 ３月 ７月 １０月 処理１ 処理２ 処理３ 処理４
a ー ー ー １月
ー a ー ー ー ３月

ー s s ー ー ３月 ７月
we １０月
e r s ー ３月 ７月 １０月
ー ー f ー ー ー ７月
＝＝＝推定例によるコード
Sub test01()
d = Range("A65536").End(xlUp).Row
MsgBox d
For i = 2 To d
For j = 4 To 7 'D-G列
If Cells(i, j) <> "" Then
Cells(i, j + 4) = Cells(1, j) '4列右の列に
End If
Next j
Next i
End Sub
こんなに簡単なことではないの？

補足

ご回答ありがとうございます。
説明が下手で、わかりにくくすみません。
ご提示のものだと、D-E-F-Gが(1)-(1)-(1)-(1)の場合、H-I-J-Kが1-3-7-10となってしまいます。
DEFGには処理が行われた月で、D-E-F-Gが(1)-(1)-(1)-(1)の場合は、
HIJKは1-□-□-□となって欲しいのです。（処理２・３・４は未のため、行われた月は入らない）