[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『式をすっきりさせたい』（のの２）
WIN…XP EXCEL…2003
いつもお世話になっています。
=IF(MID(C2,3,1)="A","新商品", IF(OR(MID(C2,2,1)="B",MID(C2,2,1)="C",MID(C2,2,1)="D",MID(C2,2,1)="E", MID(C2,2,1)="F"),"XX", IF(MID(C2,2,1)="G","YY",IF(OR(MID(C2,2,1)="H",MID(C2,2,1)="I"),"ZZ",""))))
上記の式がA列に入っています。 C列に入力された文字列の中の1文字を拾い、分類をしてA列に表示するための式です。 が、もうちょっと簡潔な式にはならないものでしょうか。
よろしくお願い致します。
=LOOKUP(MID(C2,2,1),{"0","B","G","J"},{"","XX","YY",""})
衝突しました。↑どなたでしょう。短いですね(^_^A; もうちょっとだけですが・・・。 =IF(MID(C2,3,1)="A","新商品", IF(NOT(ISERR(FIND(MID(C2,2,1),"BCDEF"))),"XX", IF(ISERR(FIND(MID(C2,2,1),"GHI")),"",CHOOSE(FIND(MID(C2,2,1),"GHI"),"YY","ZZ","ZZ"))))
（川野鮎太郎）
よく質問を読んでいませんでしたね
訂正します
=IF(MID(C2,3,1)="A","新商品",
LOOKUP(MID(C2,2,1),{"","B","G","H","J"},{"","XX","YY","ZZ",""}))
新商品のみ３文字目というのが気になりますね
もしかして
=LOOKUP(MID(C2,2,1),{"","A","B","G","H","J"},{"","新製品","XX","YY","ZZ",""})
By しげちゃん
さっそくのコメントありがとうございます。
（川野鮎太郎）さま 別のシートで試してみたのですが、C列が空白の時に"XX"が表示されてしまいました。 C列が空白のときは""を返したいです。 それから、新商品を含めそれぞれの項目に追加があった場合はどうしたらいいでしょう。 "BCDEF"に関しては、""の中に新しい条件の文字を入れたらいいのかなと思いますが、 "新商品"の"X"や"G"と"H,Ｉ"に追加が出る場合もあるのです。 宜しくお願いします。
（しげちゃん）さま
"新商品"だけ3文字目で、後は2文字目から判断しています。（自分でもすっかり忘れていましたが）
それで、
=IF(MID(C2,3,1)="A","新商品",
LOOKUP(MID(C2,2,1),{"","B","G","H","J"},{"","XX","YY","ZZ",""}))
の式を別のシートで試してみましたが、すべて"新商品”になってしまいました。
それから…分類の条件をABCDE…とアルファベット順にしていますが、実際はランダム なアルファベットが 入ります。（今は教えて頂いた式をそのままコピペして、C列に "**A"や"*B*"などを入力して試しています） その場合でもこの式でOKなのでしょうか？ また、条件のアルファベットを追加する場合があるのですが、その際はどうしたらいい でしょう。 ｛｝のつく式は初めてなので見当も付かないです…。 宜しくお願いします。
（のの２）
＞実際はランダムなアルファベットが 入ります。 と言う事ですが、実際のデータに近い物のご提示は難しいですか？ そのほうが、無駄なやりとりが少なくて済みますよ。 （こちらで検証も出来ますし。）
質問ですが、C列の状態としては 入力なし 入力有で「３文字目がA」 入力有で「２文字目がB,C,D,E,F,G,H,I」 以外の状態になることがありますか？
「新商品」以外は 別表を作り VLOOKUP関数で引っ張ってくる事にすれば 割と簡単に出来ると思いますが。 http://www.excel.studio-kazu.jp/lib/e1tw/e1tw.html
(HANA)
私もHANAさんに賛成ですね。 式ならば、 =IF(OR(C2="",ISERR(FIND(MID(C2,2,1),"BCDEFGHI"))),"", IF(MID(C2,3,1)="A","新商品", CHOOSE(FIND(MID(C2,2,1),"BCDEFGHI")-4,"XX","YY","ZZ","ZZ")))
（川野鮎太郎）
せっかくなので、載せておきます。 Ｃ列の状態が先に質問した以外にならない時で 別表をE2:F9に作るとき、A2の式は =IF(C2="","",IF(MID(C2,3,1)="A","新製品",VLOOKUP(MID(C2,2,1),$E$2:$F$9,2,0))) この様になります。 ↓別表 [E] [F] [2] B XX [3] C XX [4] D XX [5] E XX [6] F XX [7] G YY [8] H ZZ [9] I ZZ
C列に入力があるが 2文字目が「A」でなく 3文字目にE2:E9以外の文字が入る と言う場合は、エラー処理が必要になります。
(HANA)
>=IF(MID(C2,3,1)="A","新商品",
>LOOKUP(MID(C2,2,1),{"","B","G","H","J"},{"","XX","YY","ZZ",""}))
>の式を別のシートで試してみましたが、すべて"新商品”になってしまいました。
そうなりましたか? であればそれが正解です。
今回の質問は、『式をすっきりさせたい』です。 提示された式が正しいという前提で回答しています。
>実際はランダムなアルファベットが 入ります。 規則性がなければ、別表を作成して行うか、ベタでするしかないですね
参考までに、別表を作る方法が提示されていますので、ベタな方法
=IF(MID(C2,3,1)="A","新商品",IF(OR(MID(C2,2,1)={"B","C","E","F"}),"XX",IF(MID(C2,2,1)="G","YY",IF(OR(MID(C2,2,1)={"H","I"}),"ZZ",""))))
私の回答はこれで終了
By しげちゃん
（HANA）さま
>実際のデータに近い物のご提示は難しいですか？
実際には、アルファベットと文字を組み合わせた８文字の文字列が入ります。 ABC12345のような感じです。ただ、場合によってはABC1D234のように、数字と アルファベットが混ざる場合もあります。
>質問ですが、C列の状態としては 入力なし 入力有で「３文字目がA」 入力有で「２文字目がB,C,D,E,F,G,H,I」 以外の状態になることがありますか？
A〜I以外の文字が入る場合もあります。新しい番号が追加されると、新規の アルファベットが入ります。
VLOOKUP関数については、普段使わないのでピンとこないのですが、 「C列の2文字目が“B”だったら」というような場合はどうしたらいいのでしょう。
…ここまで書いて書き込みをしようとしたらすでに（HANA）さまからコメントが!! まだ試していませんが、なるほど〜♪と思いました。目から鱗です。 他の文字が入るのは滅多にないので、その場合は別表に項目を追加したらOKですよね。 …いや、ちょっと違う…。 「2文字目が「A」でなく 3文字目にE2:E9以外の文字が入る」のではなく、 「3文字目が「A」でなく、2文字目にE2:E9以外の文字が入る」になるような。 式は教えて頂いたものそのままでOKみたいなので、また明日試してみます。 ありがとうございます。
（川野鮎太郎）さま 検証する時間が今日はないので、明日また試してみます。 ありがとうございます。
（のの２）
私の書いた式はエラー処理が上手く出来ていないので無視してください(^_^A;
（川野鮎太郎）
＞…いや、ちょっと違う…。 わぁっ、申し訳ない。 ・・・何書いてんですかねぇ。 ＞「3文字目が「A」でなく、2文字目にE2:E9以外の文字が入る」 ですね。
お伺いしたかったことは（別表が作れるとして） 別表に入れない（XX,YY,ZZ等を表示したくない）場合があるか？ と言う事でした。 現在E列に存在しないアルファベットでも、それは只単に新規のもので F列に相当する物が必ず存在するのであれば、寧ろ 別表に 登録されていない事が分かりやすいように、エラーが出るようにして於いた 方がよいかもしれません。
E列に存在しない物をVLOOKUP関数で検索すると、エラーが出ます。 E列に存在しない物が有った場合、表示を無くしたいのであれば エラー処理が必要になります。
のの２さんの口振りからは、必ずF列が存在し 且つ この別表は
今後も増えていきそうなので、範囲で参照するのではなく
列で参照しておくのがよいかもしれません。
=IF(C2="","",IF(MID(C2,3,1)="A","新製品",VLOOKUP(MID(C2,2,1),$E:$F,2,0)))
こんな感じで ~~~~~
また、別表は他のシートに持っていっても大丈夫ですので
思い通りに表示できる式が完成したら、E:F列を切り取って
他のシートに貼り付けてみてください。
数式が、シート間参照の物に自動的に変更されます。
(HANA)
（HANA）さま
>=IF(C2="","",IF(MID(C2,3,1)="A","新製品",VLOOKUP(MID(C2,2,1),$E:$F,2,0)))
この式で試してみました。 上手くいきました！
>E列に存在しない物が有った場合、表示を無くしたいのであれば エラー処理が必要になります。
との事ですが、N/Aが表示されてもいいかな…とは思ってみたものの、実際表示されると イマイチ…（・ω・;） 空白になるよりは、イレギュラーなものは”その他”の認識になるので ・入力なしは空白 ・3文字目で”新商品”かどうかを識別 ・2文字目でXX YY ZZどの分類化を識別 ・そうでない場合は”その他” にしたいときはE列をどうしたらいいでしょう。
あと、このシートにはマクロが貼ってありまして、XX YY ZZ 新商品 の分類によって 塗りつぶしの色選択と罫線を引いていますが、教えて頂いた方法でXX等を表示させると 『実行時エラー 13 型が一致しません』とメッセージが出ます。
↓これが貼り付けてあります。
Private Sub Worksheet_Calculate()
Dim r As Range, myColor As Integer
For Each r In Range("a1", Range("a" & Rows.Count).End(xlUp))
myColor = xlNone
Select Case r.Value
Case "XX": myColor = 37
Case "YY": myColor = 38
Case "ZZ": myColor = 35
Case "新商品": myColor = 2
End Select
With r.Resize(, 9)
.Interior.ColorIndex = myColor
.Borders.LineStyle = IIf(myColor > 0, 1, -4142)
End With
Next
End Sub
これは一体何が起こっているのでしょう…。 このマクロを使うとして、”その他”が増えた場合は、 Case "その他": myColor = 2 を追加したらOKなんでしょうか…。 あれもこれも質問ばかりですみません（>_<） （のの２）
（しげちゃん）さま >そうなりましたか? であればそれが正解です。 ？？？ なぜ正解なのか分かりませんが、提示していただいた「ベタな方法」は よく分かりました。ありがとうございます。
（no3）さま こんなやり方もあるんですね…。 足したりかけたりすることと、任意の文字を表示させるという事がどうにも頭の中で つながりませんが（＞_＜） ありがとうございます。
（川野鮎太郎）さま 了解しました。 いろいろ考えていただいて、ありがとうございます。
（のの２）
一番単純なのは、アルファベット25文字+数字を 一覧表に全て入力しておいて、F列が未定の物には 「その他」と入れておく事かと思います。
一般的なエラー処理としては ISERRO関数とIF関数を組み合わせて使ったりします。 =IF(C2="","",IF(MID(C2,3,1)="A","新製品", IF(ISERROR(VLOOKUP(MID(C2,2,1),$E:$F,2,0)),"その他",VLOOKUP(MID(C2,2,1),$E:$F,2,0)))) ↑２行で一つの式です。 ２行目の方はISERROR関数で、その中のVLOOKUP関数がエラーかどうかを 確認しています。IF関数を使って、エラーの場合は「その他」 エラーでない場合は、VLOOKUP関数の結果を表示します。
＞Case "その他": myColor = ・・・ は追加してあげて下さい。
＞『実行時エラー 13 型が一致しません』 エラー値（#N/A!)がある為だと思いますが・・・。 出ないように変更しても上手く行かないですかね？
(HANA)
折角マクロを使うてまんのんやったらそのCalculateのマクロを取っ払ってしもうて
その代わりにこのマクロを使うてみたらどないなります？
（弥太郎）
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myColor As Integer, New_item As String
If Target.Count > 1 Then Exit Sub
If Target.Column <> 3 Or Target.Row = 1 Then Exit Sub
Application.EnableEvents = False
With Target
If .Value = "" Then
Cells(.Row, 1).Value = ""
Cells(.Row, 1).Resize(, 9).Interior.ColorIndex = xlNone
Cells(.Row, 1).Resize(, 9).Borders.LineStyle = -4142
Application.EnableEvents = True: Exit Sub
End If
New_item = "APQ"
If New_item Like "*" & StrConv(Mid(.Value, 3, 1) & "*", vbNarrow) Then
Cells(.Row, 1) = "新商品"
myColor = 2
Else
Select Case StrConv(Mid(.Value, 2, 1), vbNarrow)
Case "B" To "F"
Cells(.Row, 1) = "XX"
myColor = 37
Case "G"
Cells(.Row, 1) = "YY"
myColor = 38
Case "H", "I"
Cells(.Row, 1) = "ZZ"
myColor = 35
Case Else
Cells(.Row, 1) = "その他"
End Select
End If
Cells(.Row, 1).Resize(, 9).Interior.ColorIndex = myColor
Cells(.Row, 1).Resize(, 9).Borders.LineStyle = IIf(myColor > 0, 1, -4142)
End With
Application.EnableEvents = True
End Sub
（HANA）さま 上手くいきました。N/Aの場合はちゃんと”その他”になってます。 さらに、マクロも追加してエラーもなくなったので塗りつぶしと罫線もちゃんと 表示されています。 ありがとうございます（≧ω≦）
（弥太郎）さま すご〜く初歩的で申し訳ないのですが、今貼ってあるマクロを消して上から 教えて頂いたマクロを貼り付けて実行すると「マクロ」というダイアログボックスが 出てきます。 この先一体どうすればいいのでしょう。 通常は、シート名のタブを右クリックしてコードを表示させ、そのままそこに貼り付けて いるのですが…。 それと、”新商品”の分類の追加が出た場合…今は”A”だけですが、他の”P”とか”Q” とかが出た場合はどう追加したらいいでしょう？ よろしくお願いします。 （のの２）
これは実行するマクロではなくて、C列の２行目以下にデータを書き込むとA列にその結果が 抽出され、罫線及び色付けまでこなすっちゅう、それこそ至れり尽くせりのイベント マクロなんですワ。 なんにもしないでC列にあんさんのデータを入力してみてくらはい。 それと新商品の件なんですが、New_itemと名付けた変数を用意してそこへ新たに発生 する新商品のキーとなる文字を追加していけばいくらでも可能になります。 とりあえず上のコードをニューバージョンに書き換えときました。 （弥太郎）
（弥太郎）さま 理解しました！めっちゃ便利でびっくりです（≧ω≦） それで…今までは、C列を入力するたびにマクロが動いて書式が変わるのが面倒なので ダーッと打ち込んでから後でまとめてマクロを実行して書式を変えていました。 なので、すでに入力済みででマクロを実行していないため書式は真っ白の行があるのです。 その部分を変えたいときはどうしたら良いのでしょう。 （のの２）
それはただC列にイベントを発生させればよい事かと思います。
標準モジュール（Alt+F11→挿入→標準モジュール）にコピペし、実行すればOKです
（弥太郎）
'--------------
Sub イベント発生()
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
Cells(i, 3) = Cells(i, 3)
Next i
End Sub
（弥太郎）さま 解決しました！ が…「その他」だけ、外枠の縦線部分が引かれません。 厳密に言うと、B列とC列の間は枠線が入るのですがそれ以外のセルの縦線が 付かないのです。。。 （のの２）
Cells(.Row, 1) = "その他"の真下の行に myColor = 2 を挿入してみてくらはい。 （弥太郎）
（弥太郎）さま 上手くいきました、ばっちりです（≧ω≦） どうもありがとうございます。
それから、いろいろ方法を考えてくださった皆様、ありがとうございます。 どれも便利そうで…どの方法を選択するか悩む位です。
いつも思っているのですが、ここには本当にお世話になっていて… 過去ログをみて解決することも多々ありますし質問をして助けていただくことも 本当に沢山あります。 質問の仕方が拙く知識も足りないので申し訳ないことばかり…（・ω・;） なのに、嫌がらずに教えていただいていて本当に感謝しています。 ほんとにありがとうございます。今後ともどうぞよろしくお願いします。 （のの２）
教えて頂いた方法でファイルを使用しているのですが、疑問点があります。
Ｃ列に入力した文字列によって、セルの枠線と塗りつぶしをしていますが、 CTRL+Ｄで上のセルをそのままコピーする→○ 〃 Ｃ列を含む複数列（１行）をコピーする→× Ｃ列をコピーし、複数のＣ列にペーストする→× このような感じで、セルをひとつだけコピペすれば行全体の書式が変わりますが Ｃ列を含む複数列をコピペしたり、複数の行にコピペすると行の全体の書式が 変更されません。 また、入力後にＣ列にイベントを発生させても書式は変わりません。 再度ひとつひとつ入力しなおすか、Ｃ列だけでコピペすれば変わるのですが…。
ＢＣＤ列まで同じ内容の行というのが頻繁に出てくるので、まとめてコピペできたら 楽なんですけど…。 無理なんでしょうか。 （のの２）
訂正します。
>また、入力後にＣ列にイベントを発生させても書式は変わりません。 この部分ですが、変わる時もありました。 １度目…追加入力した分の最後の２行を残して書式が変わった ２度目…１度目の入力後、さらに追加入力してイベント発生すると１度目に 変わらなかった書式も変わった。
（のの２）
のの２はん、ごめんなはれや。すっかり見落としてましたワ。
知り合いからのご指摘で気付いたんですけど、もう見ておられないでしょうなぁ。（汗
もしご覧になられたらイベント発生を下のコードに書き換えておくんなはれ。
（弥太郎）
Sub イベント発生()
Application.EnableEvents = True
For i = 2 To Range("a:d").Cells.Find("*", , , , xlByRows, xlPrevious).Row
Cells(i, 3) = Cells(i, 3)
Next i
End Sub
見落としの償いですワ。
イベント発生マクロを走らせる手間を省いとります。
せやけど、もう見てくれんやろなぁ・・・。＾＾
（弥太郎）
'-------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myColor As Integer, New_item As String, i As Long
If Target.Count = 1 Then
If Target.Column <> 3 Or Target.Row = 1 Then Exit Sub
Application.EnableEvents = False
With Target
If .Value = "" Then
Cells(.Row, 1).Value = ""
Cells(.Row, 1).Resize(, 9).Interior.ColorIndex = xlNone
Cells(.Row, 1).Resize(, 9).Borders.LineStyle = -4142
Application.EnableEvents = True: Exit Sub
End If
New_item = "APQ"
If New_item Like "*" & StrConv(Mid(.Value, 3, 1) & "*", vbNarrow) Then
Cells(.Row, 1) = "新商品"
myColor = 2
Else
Select Case StrConv(Mid(.Value, 2, 1), vbNarrow)
Case "B" To "F"
Cells(.Row, 1) = "XX"
myColor = 37
Case "G"
Cells(.Row, 1) = "YY"
myColor = 38
Case "H", "I"
Cells(.Row, 1) = "ZZ"
myColor = 35
Case Else
Cells(.Row, 1) = "その他"
myColor = 2
End Select
End If
Cells(.Row, 1).Resize(, 9).Interior.ColorIndex = myColor
Cells(.Row, 1).Resize(, 9).Borders.LineStyle = IIf(myColor > 0, 1, -4142)
End With
ElseIf Selection.Column <= 3 And Selection.Columns.Count + Selection.Column >= 3 _
And Application.CutCopyMode Then
For i = Selection.Row To Selection.Rows.Count + Selection.Row
Cells(i, 3) = Cells(i, 3)
Next i
End If
Application.EnableEvents = True
End Sub
（弥太郎）さん
コードを書いていただいたのにお返事が遅くなりました。すみません。 週末は見れないのです。
>イベント発生マクロを走らせる手間を省いとります。 ということなのですが…。 何が変わったのかわかりません（＞_＜） コードの最初と最後が変わっているのは分かるのですが、貼り付けなおしても 前と変わらないような…？
それから、「イベント発生」させる時に、終了までに時間がかかる時とかからない時が あるのですが、はほかのEXCELファイルを開いているとその他のファイルにも「イベント 発生」しているということなのでしょうか。 （のの２）
> 前と変わらないような…？ なんででっしゃろ？ ↓で保存した上複数の行列をコピぺ（C列を含む）してみてくらはい。 http://kenmax.mydns.jp/~kiriki/cgi-bin/joyful/img/8635.xls かういう事を仰有ってるんやないんでっか？ それとも違う事？ （弥太郎）
（弥太郎）さん
Ｃ列のみをコピーして、１行のみペースト→行全部の書式が変更→○ 複数行にペースト→Ｃ列の書式のみ変更→× Ｃ列を含む複数列をコピーしてペースト→コピーした複数列のみ書式が変更→× で、×になった時には「イベント発生」をして全部の書式が変わるようにしています。 この「イベント発生」をやらなくても大丈夫になったのかと思ったのです。 私が何か勘違いしてるんでしょうか…。 （のの２）
どうも良くわからないんですが・・・ A B C D E F G H I 1 項目 2 YY 111 GGG a ....................... 3 新商品 222 AAA b 4 XX 333 BBB c 5 ZZ 444 HHH d 6 ZZ 555 III e
例えばこんなデータが並んどるとして、A2からD6を（B2からD6とかC2からC6とか）
を７行目以下にコピペすれば自動的に貼り付けた範囲のI列まで書式が変更でけまっしゃろ？
さういう事ではないんでっか？
（弥太郎）
（弥太郎）さん
自動的にI列まで書式が変わるのは、Ｃ列を１行分だけコピーし１行分だけペーストした 時だけです。 Ｃ２をコピーしてＣ７にペーストすればＡ７〜Ｉ７まで書式が変わりますが、 〃 Ｃ７、Ｃ８にペーストした場合はＣ７とＣ８のみ書式変更 Ｃ２〜Ｅ２までコピーしてＣ７〜Ｅ７にペーストした場合は、Ｃ７〜Ｅ７の書式が変わります。 そのあとで「イベント発生」をするとＡ〜Ｉまで書式が変わります。 （のの２）
おっかしいなぁ・・・。 当方ではペーストしたＡ列からＩ列まで全て書式が変わりまっせ。 一遍新しいブックでテストしてみてくらはい。 それと、他にマクロは登録されとりまっか？ （弥太郎）
（弥太郎）さん
新規ファイルにコードをコピペしても同じでした…。
>それと、他にマクロは登録されとりまっか？ いいえ。新しく作って頂いたコードと標準モジュールに貼り付けたコードだけです。
私のやり方が何か違っているのでしょうか（；ω；） （のの２）
う〜ん すんまへんがもう一度↓を保存したうえ試して貰えまへんか？ http://kenmax.mydns.jp/~kiriki/cgi-bin/joyful/img/8638.xls これであきまへんでしたら、どうもこうもなりまへんなぁ・・・。 なお、イベント発生に時間がかかるみたいなんで、新たに再計算っちゅうマクロを作 っときました。 それとイベントが途中で途切れたばやいの為のマクロも登録されとります。
（弥太郎）
（弥太郎）さん
再度保存してチャレンジしてみましたが…変わらず（；ω；）
イベント発生に関しては、ものすご〜く早くなりました。が、実行した後に 「実行時エラー’1004’ アプリケーション定義またはオブジェクト定義の エラーです」というメッセージが出ます。 でも、書式自体はきちんと変わっているようです。このままでも大丈夫なのでしょうか？
それと…以前はＣ列に誤入力した際、DELキーで消去すると書式も全部消えたのですが 今回は書式が残ってしまいます。再度正しく入力しなおしても書式はそのままで、 イベント発生させないと変わらないのですが…。 これは前のままのほうが良かったです…。 勝手ばかり言って申し訳ありません。ほんとに。 （のの２）
両手を拡げて手のひらを上に向け、肩をすぼめて「Why?」状態ですワ。＾＾ 何度も検証してみましたが、エラーはでまへん。 また、C列をDelキーで消去すると、その行の書式は全部消えます・・・。 なにが障ってますんやろなぁ・・・？？？ （弥太郎）
そのシートモジュールを表示します。コードの左サイドにグレーゾーンがありますから If Target.Count = 1 Then の行辺りをクリックしてくらはい。その行が茶色に染まり ますから、その状態でエクセルに戻ります。 C列のいずれかのセルをDelキーで消去するとコードが中断されて先ほどの行へ飛びます から、F８を押し下げます。一行一行マクロが実行されていきますから、エクセルに戻 たり、F8を押したりしてどんな塩梅に作業が進んでいるか確認してみて下さい。 （弥太郎）
（弥太郎）さん
お手数をおかけしています。申し訳ないです（；ω；） そろそろ時間切れなので、明日またクリアな頭で考えたいと思います。 分かったり分からなかったりしたら質問しますので宜しくお願いします。 （のの２）
これは複数のデータをDelしても対応するマクロですけど、１セルのDelにも反応しない
やったら意味無いか＾＾
（弥太郎）
シートモジュール
'--------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myColor As Integer, New_item As String, i As Long
With Target
If .Count = 1 Then
If .Column <> 3 Or .Row = 1 Then Exit Sub
Application.EnableEvents = False
If .Value = "" Then
Cells(.Row, 1).Value = ""
Cells(.Row, 1).Resize(, 9).Interior.ColorIndex = xlNone
Cells(.Row, 1).Resize(, 9).Borders.LineStyle = -4142
Application.EnableEvents = True: Exit Sub
End If
New_item = "APQ"
If New_item Like "*" & StrConv(Mid(.Value, 3, 1) & "*", vbNarrow) Then
Cells(.Row, 1) = "新商品"
myColor = 2
Else
Select Case StrConv(Mid(.Value, 2, 1), vbNarrow)
Case "B" To "F"
Cells(.Row, 1) = "XX"
myColor = 37
Case "G"
Cells(.Row, 1) = "YY"
myColor = 38
Case "H", "I"
Cells(.Row, 1) = "ZZ"
myColor = 35
Case Else
Cells(.Row, 1) = "その他"
myColor = 2
End Select
End If
Cells(.Row, 1).Resize(, 9).Interior.ColorIndex = myColor
Cells(.Row, 1).Resize(, 9).Borders.LineStyle = IIf(myColor > 0, 1, -4142)
ElseIf Selection.Column <= 3 And Selection.Columns.Count + Selection.Column >= 3 _
And Application.CutCopyMode Then
For i = Selection.Row To Selection.Rows.Count + Selection.Row
Cells(i, 3) = Cells(i, 3)
Next i
ElseIf Selection.Column <= 3 And Selection.Columns.Count + Selection.Column >= 3 _
And Cells(.Row, Selection.Column) = "" Then
Cells(.Row, 1).Resize(Selection.Rows.Count, 9).Interior.ColorIndex = xlNone
Cells(.Row, 1).Resize(Selection.Rows.Count, 9).Borders.LineStyle = -4142
End If
End With
Application.EnableEvents = True
End Sub
’標準モジュール
'------------------------
Sub 再計算()
Dim myColor As Integer, New_item As String, i As Long, x, tbl, y
tbl = Range("a1").Resize(Range("a:d").Cells.Find("*", , , , xlByRows, xlPrevious).Row, 9)
New_item = "APQ"
ReDim x(2 To UBound(tbl, 1), 1 To 2)
For i = 2 To UBound(tbl, 1)
x(i, 1) = Cells(i, 1).Resize(, 9).Address(0, 0)
If Not IsEmpty(tbl(i, 3)) Then
If New_item Like "*" & StrConv(Mid(tbl(i, 3), 3, 1) & "*", vbNarrow) Then
tbl(i, 1) = "新商品"
x(i, 2) = 2
Else
Select Case StrConv(Mid(tbl(i, 3), 2, 1), vbNarrow)
Case "B" To "F"
tbl(i, 1) = "XX"
x(i, 2) = 37
Case "G"
tbl(i, 1) = "YY"
x(i, 2) = 38
Case "H", "I"
tbl(i, 1) = "ZZ"
x(i, 2) = 35
Case Else
tbl(i, 1) = "その他"
x(i, 2) = 2
End Select
End If
Else
x(i, 2) = xlNone
End If
Next i
Application.EnableEvents = False
Cells(1, 1).Resize(UBound(tbl, 1), UBound(tbl, 2)) = tbl
Cells(1, 1).Resize(UBound(tbl, 1), 9).Borders.LineStyle = 1
For i = 2 To UBound(tbl, 1)
Range(x(i, 1)).Interior.ColorIndex = x(i, 2)
If x(i, 2) = xlNone Then Range(x(i, 1)).Borders.LineStyle = -4142
Next i
Application.EnableEvents = True
End Sub
（弥太郎）さん
また新しいコードが。スゴイです…（＾＾;）
今朝から、元のファイルをコピーしたものに昨日教えて頂いたコードをふたつ貼り付けて やってみたところ…。 複数行のコピペに関しては同じですが、DELキーで書式は消えるというのは大丈夫でした。 もちろん、実行速度も格段にアップしています！
で、懲りずに昨日のファイルでもやってみたのですが。 朝一の段階ではDELキーで書式が消えたのに、一回マクロを実行するとDELキーを 使っても書式が消えなくなりました。 実行した際、 「実行時エラー’1004’’Range’メソッドは失敗しました。’Global’オブジェクト」 というメッセージが出て、デバックをクリックすると 「Range(x(i,1)).Interior.ColorIndex=x(i,2)」 のところが黄色く塗りつぶしになりました。で、ここから先は昨日と同じ状況に。 一体何が起こっているのか…。
マクロに関しては無知もいいところなので、自力で問題点を見つけられない状態です。 お手数をおかけして申し訳ないです。
が、実行速度がものすごく速くなったのと、DELキーも今日の分は使えるのでこれで使って行こうと 思います。 ありがとうございます（≧∀≦） （のの２）
そのエラーが発生した時点ではイベントを停止した状態なんですワ。
せやからその後の作業にはイベント無効になり、肝心のチェンジイベントマクロが言う
事ききまへん。
Sub イベント再発生()
Application.EnableEvents = True
End Sub
これを標準モジュールに貼り付けて実行するとイベントマクロは息を吹き返します。
それとは別にエラーの方も気ぃになりますんで、標準モジュールの再計算コードの
最も下に有る
→ For i = 2 To UBound(tbl, 1) ←この行に
Range(x(i, 1)).Interior.ColorIndex = x(i, 2)
If x(i, 2) = xlNone Then Range(x(i, 1)).Borders.LineStyle = -4142
Next i
に例のブレークポイントを設定して、実行してくらはい。
エラーが出たらx(i,1) にカーソルを近づけるとその値が、またx(i,2)に近づけると
x(i,2)の値がチップテキストに表示されますから、それを教えておくんなはれ。
こちらではエラーがでまへんから再現のしようがありまへんもんで・・・。
とりあえずそちらから解決していきまひょか。 （弥太郎）
（弥太郎）さん
あの〜
＞最も下に有る
→ For i = 2 To UBound(tbl, 1) ←この行に
Range(x(i, 1)).Interior.ColorIndex = x(i, 2)
If x(i, 2) = xlNone Then Range(x(i, 1)).Borders.LineStyle = -4142
Next i
の部分ですが、私のコード
「If x(i, 2) = xlNone Then Range(x(i, 1)).Borders.LineStyle = -4142」
がありません…。昨夜のコードから増えたという事なんでしょうか？？？
でも、大丈夫な方のファイルのコードにも付いていなかった。それはそれでOKという事にして。
とりあえず… For i = 2 To UBound(tbl, 1) を茶色にして実行しました。 すると、その行のForの手前までが茶色、残りは黄色になり、下の行の「Range〜」に カーソルを近づけるとどこに持っていっても＜インデックスが有効範囲にありません＞ と表示されました。 こういう事をしたらいいんでしょうか…？ （のの２）
>昨夜のコードから増えたという事なんでしょうか？？？ いいえぇ、上のコードをご覧になればわかりますけど、そのままでっせ。 「If x(i, 2) = xlNone Then Range(x(i, 1)).Borders.LineStyle = -4142」 はC列に空白行があってこのマクロを実行した時、その罫線を削除する為のコードです ワ。 そういう事がなければその行は不要なんですけどナ。 今一度上のコードをコピペして試してみてくれまへん？ いいえぇな、マクロがどんどん進化しとりますから、前のんはどんなんかわかりまへん ねん。＾＾ エラーの時点で i にカーソルを合わせてみてくらはい。なんぼになってます？ （弥太郎）
（弥太郎）さん
>エラーの時点で i にカーソルを合わせてみてくらはい。なんぼになってます？ ｉ＝「6762」になってます。
で、その後に >これは複数のデータをDelしても対応するマクロですけど の分のマクロをコピペしてみたら…エラーも出なくなったしうまくいってしまいました。 このまま保存するべきか、エラーの状態のまま残しておくべきか………。 ちょっと考えましたが、エラーの謎も残っているので保存しておきます。 複数のデータがDELキーで消えるの、便利で良いです（≧∀≦）b （のの２）
あのぅ、誠に申し訳ないんですけど、 If x(i, 2) = xlNone Then Range(x(i, 1)).Borders.LineStyle = -4142 を If x(i, 2) = xlNone Then Range(x(i, 1)).Resize(, 9).Borders.LineStyle = -4142 に差し替えといてくだはい。（何処が進化しとんのや＾＾）
さて、そのエラーの出るマクロ、ここへ貼り付けてもらえまへん？ どこか悪いところがあるんでっしゃろから精査してみますワ。 （弥太郎）
（弥太郎）さん
コード貼り付けます。
'Sub イベント発生()
' Application.EnableEvents = True
' For i = 2 To Range("a:d").Cells.Find("*", , , , xlByRows, xlPrevious).Row
' Cells(i, 3) = Cells(i, 3)
' Next i
' End Sub
Sub 再計算()
Dim myColor As Integer, New_item As String, i As Long, x, tbl
tbl = Range("a1").Resize(Range("a:d").Cells.Find("*", , , , xlByRows, xlPrevious).Row, 9)
New_item = "XZY"
ReDim x(2 To UBound(tbl, 1), 1 To 2)
For i = 2 To UBound(tbl, 1)
If Not IsEmpty(tbl(i, 3)) Then
x(i, 1) = Cells(i, 1).Resize(, 9).Address(0, 0)
If New_item Like "*" & StrConv(Mid(tbl(i, 3), 3, 1) & "*", vbNarrow) Then
tbl(i, 1) = "新商品"
x(i, 2) = 2
Else
Select Case StrConv(Mid(tbl(i, 3), 2, 1), vbNarrow)
Case "G", "C", "E", "W"
tbl(i, 1) = "XX"
x(i, 2) = 35
Case "M"
tbl(i, 1) = "YY"
x(i, 2) = 38
Case "T", "N", "A", "P"
tbl(i, 1) = "ZZ"
x(i, 2) = 37
Case Else
tbl(i, 1) = "その他"
x(i, 2) = 2
End Select
End If
End If
Next i
Application.EnableEvents = False
Cells(1, 1).Resize(UBound(tbl, 1), UBound(tbl, 2)) = tbl
Cells(1, 1).Resize(UBound(tbl, 1), 9).Borders.LineStyle = 1
For i = 2 To UBound(tbl, 1)
Range(x(i, 1)).Interior.ColorIndex = x(i, 2)
Next i
Application.EnableEvents = True
End Sub
Sub test()
Application.EnableEvents = True
End Sub
↑これが標準モジュールのモジュール１に貼り付けてあった分です。判断基準になるＣ列の アルファベットはこちらで変更しています。 （のの２）
おおきに〜。 せやけどエラーがでない・・・。＾＾ 昼からちょっと出かけますんで、今日は無理かもしれまへんし、そうでないかもしれまへん。＾＾ （弥太郎）
データ量による不都合かもと思うて20000行のデータで検証してみましたけど
エラーはでまへんでしたワ。
こうなると、ただ単にのの２はんと相性が悪いだけの話かもしれまへんなぁ。＾＾
（弥太郎）
（弥太郎）さん
いろいろありがとうございます。 相性が悪いということもあるんですね…（￣□￣;） 新しく作って頂いたコードのほうでは特に問題なく処理できていますので、大丈夫です。 万が一、何かややこしいことが起こったらまた来ますので…宜しくお願い致します。 （のの２）
（弥太郎）さん
さっそくすみません。 今までは、データの途中で行挿入してＦ４で挿入する行を増やして行けたのですが 新しいマクロになってから出来なくなりました。 「ctrl ＋」で行を増やしていくことは出来ますが…。 これもマクロが関係しているのでしょうか。 （のの２）
それがしマウス派ですからＦ４で挿入する行を増やすとかCtrl＋で行を増やす等の やりかたは承知しとりまへん、悪しからず。（汗 （弥太郎）
またまた知人に催促されましてなぁ。
ちょっとF4キーを調べてみたんですけど、これって直前の操作を繰り返す（一度だけ）
とちゃいまっか？
行挿入はイベントに引っかかりまへんからF4キーも有効でしたで、えぇ。
それと、コピーは確かに一度だけしかでけまへんでしたから複数回でけるように組み直
してみました。F4は効きまへんからCtrl+Vでやりまひょう。
知人とのの２はんには泣かされますワ、ほんまに。＾＾
顔で泣いて心で笑てる（弥太郎）
シートモジュール
'--------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myColor As Integer, New_item As String, i As Long, adrs As String
With Target
If .Count = 1 Then
If .Column <> 3 Or .Row = 1 Then Exit Sub
Application.EnableEvents = False
If .Value = "" Then
Cells(.Row, 1).Value = ""
Cells(.Row, 1).Resize(, 9).Interior.ColorIndex = xlNone
Cells(.Row, 1).Resize(, 9).Borders.LineStyle = -4142
Application.EnableEvents = True: Exit Sub
End If
New_item = "APQ"
If New_item Like "*" & StrConv(Mid(.Value, 3, 1) & "*", vbNarrow) Then
Cells(.Row, 1) = "新商品"
myColor = 2
Else
Select Case StrConv(Mid(.Value, 2, 1), vbNarrow)
Case "B" To "F"
Cells(.Row, 1) = "XX"
myColor = 37
Case "G"
Cells(.Row, 1) = "YY"
myColor = 38
Case "H", "I"
Cells(.Row, 1) = "ZZ"
myColor = 35
Case Else
Cells(.Row, 1) = "その他"
myColor = 2
End Select
End If
Cells(.Row, 1).Resize(, 9).Interior.ColorIndex = myColor
Cells(.Row, 1).Resize(, 9).Borders.LineStyle = IIf(myColor > 0, 1, -4142)
ElseIf Selection.Column <= 3 And Selection.Columns.Count + Selection.Column >= 3 _
And Application.CutCopyMode Then
adrs = Selection.Address
work (adrs)
ElseIf Selection.Column <= 3 And Selection.Columns.Count + Selection.Column >= 3 _
And Cells(.Row, Selection.Column) = "" Then
Cells(.Row, 1).Resize(Selection.Rows.Count, 9).Interior.ColorIndex = xlNone
Cells(.Row, 1).Resize(Selection.Rows.Count, 9).Borders.LineStyle = -4142
End If
End With
Application.EnableEvents = True
End Sub
標準モジュールへ
'-------------------
Public flag As Boolean
Sub 再計算()
Dim adrs As String
adrs = Range("a1").Resize(Range("a:d").Cells.Find("*", , , , xlByRows, xlPrevious).Row, 9).Address
flag = True
work (adrs)
End Sub
Sub work(adrs)
Dim i As Long, New_item As String, tbl, x
tbl = Cells(Range(adrs).Row, 1).Resize(Range(adrs).Rows.Count, 9).Value
ReDim x(1 To UBound(tbl, 1), 1 To 2)
New_item = "APQ" '←は実情に合わせませう。
For i = IIf(flag, 2, 1) To UBound(tbl, 1)
x(i, 1) = Cells(Range(adrs).Row + i - 1, 1).Resize(, 9).Address(0, 0)
If Not IsEmpty(tbl(i, 3)) Then
If New_item Like "*" & StrConv(Mid(tbl(i, 3), 3, 1) & "*", vbNarrow) Then
tbl(i, 1) = "新商品"
x(i, 2) = 2
Else
Select Case StrConv(Mid(tbl(i, 3), 2, 1), vbNarrow)
Case "B" To "F"
tbl(i, 1) = "XX"
x(i, 2) = 37
Case "G"
tbl(i, 1) = "YY"
x(i, 2) = 38
Case "H", "I"
tbl(i, 1) = "ZZ"
x(i, 2) = 35
Case Else
tbl(i, 1) = "その他"
x(i, 2) = 2
End Select
End If
Else
x(i, 2) = xlNone
End If
Next i
Application.EnableEvents = False
Cells(Range(adrs).Row, 1).Resize(UBound(tbl, 1), UBound(tbl, 2)) = tbl
Cells(Range(adrs).Row, 1).Resize(UBound(tbl, 1), 9).Borders.LineStyle = 1
For i = IIf(flag, 2, 1) To UBound(tbl, 1)
Range(x(i, 1)).Interior.ColorIndex = x(i, 2)
If x(i, 2) = xlNone Then Range(x(i, 1)).Resize(, 9).Borders.LineStyle = -4142
Next i
If Not flag Then
Application.CutCopyMode = xlCopy
Range(adrs).Copy
End If
flag = False
Application.EnableEvents = True
End Sub
Sub イベント再発生()
Application.EnableEvents = True
flag = False
End Sub
（弥太郎）さん またまた新しいコードが…。 でも、何が変わったのかわかりません。すみません（＞_＜）
＞コピーは確かに一度だけしかでけまへんでしたから複数回でけるように組み直… の所だと思うのですが、わからず。 それで、色々試していたら…………… 前の方で「複数行にコピペすると書式が反映されない」と言っていたのがちゃんと 出来る事がわかりました（・ω・;）
＞Ctrl+Vでやりまひょう。 を読んでいて、自分のコピペと（弥太郎）さんのコピペがやり方が違うとわかりまして。 私は、コピーしたい所を範囲選択して CTRL+Ｃ ペーストしたい範囲をシフトと矢印キーで 選択し、Enterでやっていました。 が、上の文を見てもしや…と思い、CTRL+Ｖ もしくは、右クリックでコピペしたら前の コードでも ゃんと書式が変わることが判明しました。 右クリックの時も、ちゃんと「貼り付け」をしないと駄目というのも分かりました。
色々お騒がせしてすみませんでした（＾＾;） あと、催促してくださっている知人の方もお世話になってます。ありがとうございます。 とりあえず、自分の思い込みっぷりを…ご報告まで。。。 （のの２）
大変心苦しいのですが… 項目がひとつ追加になりました。すでに長い質問内容なのですがこのまま続けた方がいいのかな？ と思うのでここに書きます。
B列に入る内容の1文字目が"L"の時はA列に"SS"を表示させ、今まで使ってない色で塗りつぶし したいのです。 条件１）B列の3文字目が"APQ"ならA列に"新商品” 書式は枠線のみ。（今まで通り） 条件２） 〃 1文字目が"L"なら 〃 "SS" 書式は枠線と任意の色（36番あたり） 条件３） 〃 2文字目が………いっぱいあるので省略（今まで通り）
1文字目から始まるなら Select Case StrConv(Mid(.Value, 2, 1), vbNarrow) の ↑ここが LEFT なのかな…とか条件を１つ 追加したらいいのかな…とか、推測はするのですが、そこで思考がストップしています。 進歩が無くて申し訳ないのですが、お力をお貸しください。 宜しくお願いいたします。 （のの２）
>B列に入る内容の1文字目が"L"の時はA列に"SS"を表示させ、今まで使ってない色で塗りつぶし あんさんは毎日この作業に携わっていますから、よ〜く行程を理解した上のリクエス トでっしゃろけど、当方はなんのこっちゃらサッパリわかりまへん。＾＾ 新たに初めからスレを立てて、新たなマクロを呈示してもろうた方がええんとちゃい まっか？
それにしてもこれは随分昔の話と思われますけど、未だにそれがしのコードをご理解 頂けてないとは・・・（涙
とにかく我が輩の手元を離れたマクロには何の未練もありまへんのんで、焼くなり 煮るなり随意に。 （弥太郎）
まぁまぁ、弥太郎さん。 そう仰らずに。
のの２さんも、「こんな長いコード分からない」 ではなく、小さくして考えてみるのが良いと思いますよ。
＞↑ここが LEFT なのかな…とか Mid ってワークシート間数でも有りますよね。 VBAのMid関数の説明には 構文 Mid(string, start[, length]) と成っていますが、ワークシート関数の方の説明では 書式 MID(文字列,開始位置,文字数) です。 （詳しく違いが知りたい場合は、ヘルプをご覧下さい。）
＞条件を１つ追加したらいいのかな 今のコードでは If 3文字目が APQ Then 新製品 Else （そうでない場合で） 2文字目が ………いっぱいあるので省略（今まで通り） End If
と成っています。
「更に」で条件を増やしたい場合は、ElseIf を使って下さい。
↓校外リンクですが・・・。 http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_if_select.html よねさんのWordとExcelの小部屋 より Excel(エクセル) VBA入門：条件分岐処理(If〜Then,Select Case)
(HANA)
（弥太郎）さん >それにしてもこれは随分昔の話と思われますけど、未だにそれがしのコードをご理解 >頂けてないとは・・・（涙 お世話になっただけで、理解力が低く申し訳ありません。 煮るのも焼くのも手段が分からないので、当面の間はそのままにしておこうと思います。
(HANA)さん 紹介していただいたリンク先は時々拝見しており、今回もここにコメントする前に 覗いていたんですが…………。 自分の無能さに凹んでます。 マクロに関しては、きちんと勉強しなければ理解できない類のこと（私の能力的に）だなと 思ってはいるのですが、まとまった時間がなかなかとれずにいます。家では出来ないので（涙 それで、今回の件は当面は"L"から始まる物は別のシートに入力して行く事にしました。
いつか自力で解決させるとして… >「更に」で条件を増やしたい場合は、ElseIf を使って下さい。 という事なんですけど、"L"で始まって、かつ「2文字目に該当する文字がある」場合も想定 される場合は、 >If 3文字目が APQ Then > 新製品 > Else （そうでない場合で） > 2文字目が ………いっぱいあるので省略（今まで通り） > End If この「2文字目が」の部分を「"L"から始まる」にし、「更に」の部分を「2文字目が」の内容に したらいいんですよね？
（のの２）
いいえ If c.Value = 1 Then myColor = 3 '赤 ElseIf c.Value = 2 Then myColor = 6 '黄 Else myColor = 10 '緑 End If もしcの値が「1」なら 赤 それ以外で、もしcの値が「2」なら 黄 それ以外の時 緑 ですので
If 3文字目が APQ Then
新製品
ElseIf 1文字目が "L" Then
"SS"
Else （そうでない場合で）
2文字目が ………いっぱいあるので省略（今まで通り）
End If
の様にするのが良いと思います。
↓試して居ませんが
ElseIf StrConv(Mid(.Value, 1, 1), vbNarrow) = "L" Then
Cells(.Row, 1) = "SS"
myColor = 6
(HANA)
(HANA)さん
IFとELSEの間にELSEIFが入るのですか。 一番最初に某リンク先だかで「ELSEIF」を見た感想…「"ELSEIF"なんじゃそら？間にスペース 入らないの？」でしたが そういうのがマクロの世界にはあるんですね。 長いマクロを沢山変更しなくてはいけないのかと思っていましたが、(HANA)さんに教えて頂いた コードを途中に追加したら上手くいきました。 助かりました（；ω；） ありがとうございました。 （のの２）
＞一番最初に某リンク先だかで「ELSEIF」を見た感想 【見た】だけだからですよ。 本当に分かりたいなら、同じ事を実際にやってみる事です。
リンク先に有る表と同じ表をエクセルで作成し VBEに同じコードを書き、実行してみる。
やって居られないですよね？ やってみたら ＞間にスペース入らない のは分かると思います。
何故私が上記リンク先を紹介したと思いますか？ 今回の件に関係が有ったからですよ。
今までに弥太郎さんが作ってくださったコードと 私がリンクした先に書いてあることと 今回私が書いた部分と 見比べてください。
たったこれだけの事でも、その他に応用がきくように成ると思います。
(HANA)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.