人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

同じ値を探し出して、行を並び替え、色をつけるVBAマクロをお願いいたします。


顧客リストがあります。

A列には商品名
F列にお客様名が並んでいます。


A,F
1りんご,高橋一
2みかん,斉藤二
3オレンジ,高橋一
4すいか,田中三
5桃,高橋一
6レモン,鈴木四
7苺,斉藤二


ここでマクロをかけると↓

1りんご,高橋一
2オレンジ,高橋一
3桃,高橋一
4みかん,斉藤二
5苺,斉藤二
6すいか,田中三
7レモン,鈴木四

と列ごと並び替えられるようにしてほしいのです。
同じ名前を比べて同じ名前の一番上の行のすぐ下に並んでいくイメージです。
(同性同名はこの際無視します)

そして、同じ名前が発生したときには、今回の例では
A1?F3まで黄色、A4?F4まではオレンジなどと自動的にセルに色を塗るようにして下さい。(途中のB,C,Dも色塗り)

色の順番は上から、
黄色⇒橙⇒黄緑⇒水色⇒濃青⇒薄灰⇒濃灰⇒濃緑⇒黒
でお願いします。コード内でRGB値を調節できるようにしておいて下さい。

それ以降は適当にRGB値をランダムに調整してくださると助かります。

よろしくお願いいたします。

●質問者: naranara19
●カテゴリ:コンピュータ 科学・統計資料
✍キーワード:A1 F3 F4 RGB VBA
○ 状態 :終了
└ 回答数 : 4/4件

▽最新の回答へ

1 ● SALINGER
●70ポイント

色はインデックスカラーにしていて、コード中の色の指定のところで

最初の色だけを指定しています。

インデックスカラーはこちらとかで番号を確認できます。

http://homepage3.nifty.com/boole/reference.htm


最初の9色の後は使っていないインデックスカラーを使います。

56色以上は無いのでエラーとなります。

RGBで更に細かく色を指定したい場合は、コードを修正しますが、

その場合10色目以降をどのように決定するかが曖昧です。


Sub Macro()
 Dim i As Long
 Dim j As Long
 Dim lastRow As Long
 Dim k As Long
 Dim h As Variant
 Dim l As Integer
 Dim f As Boolean
 Dim c As Integer
 
  '色の指定
 h = Array(6, 45, 35, 20, 5, 15, 16, 10, 1)
 
 lastRow = Cells(Rows.Count, 1).End(xlUp).Row
 
 For i = 1 To lastRow
 k = i
 For j = i + 1 To lastRow
 If Cells(i, "F").Value = Cells(j, "F").Value Then
 If j <> i + 1 Then
 Rows(j).Cut
 Rows(i + 1).Insert Shift:=xlDown
 End If
 i = i + 1
 End If
 Next j
 l = l + 1
 If l <= UBound(h) + 1 Then
 Range("A" & k & ":F" & i).Interior.ColorIndex = h(l - 1)
 Else
 Do
 f = False
 c = c + 1
 For j = 0 To UBound(h)
 If h(j) = c Then
 f = True
 Exit For
 End If
 Next
 Loop While f
 Range("A" & k & ":F" & i).Interior.ColorIndex = c
 End If
 Next i
End Sub
◎質問者からの返答

いつもありがとうございます!

早速やってみたのですが、お二人とも、同じ人以外のときも色が塗られてしまいまして。

同じ名前が2人以上のときのみ、色を塗っていただきたいのです。それ以外は塗らなくて結構です。ちょっと質問の仕方がまずかったかと思います。

恐れ入りますがよろしくお願いいたします。


2 ● Mook
●70ポイント

一応仕様通りに作成してみました。

同じ色を繰り返し使用する場合は、ColorLoopMode を True にして見てください。

Option Explicit

'// 色の使用方法
Const ColorLoopMode = False
' True ・・・・ 定義された色を繰り返し使用
' False ・・・・ 定義された色が終わったら、ランダムな色を使用

Sub naranaraPaint()
  '// 色の定義:定義されている分だけ使用
 Dim cArray As Variant
 cArray = Array(RGB(255, 255, 0), RGB(255, 192, 0), RGB(146, 208, 80), RGB(0, 176, 240), RGB(0, 0, 255), _
 RGB(216, 216, 216), RGB(128, 128, 128), RGB(0, 176, 80), RGB(0, 0, 0))

  '// データの並べ替え
 Columns("A:F").Sort Key1:=Range("F1"), order1:=xlAscending, Header:=xlGuess, Orientation:=xlTopToBottom

 
 
  '// セルの着色
 Dim r As Integer
 r = 1
 
 Dim ci As Long
 ci = 0
 
 Dim cl As Long
 cl = cArray(ci)
 Do While Cells(r, "F") <> ""
 Range(Cells(r, "A"), Cells(r, "F")).Interior.Color = cl
 If Cells(r, "F").Value <> Cells(r + 1, "F").Value Then ci = ci + 1
 If ColorLoopMode = True And ci > UBound(cArray) Then ci = 0
 
 If ci <= UBound(cArray) Then
 cl = cArray(ci)
 Else
 cl = RGB(Int(Rnd() * 256), Int(Rnd() * 256), Int(Rnd() * 256))
 End If
 r = r + 1
 Loop
End Sub
◎質問者からの返答

お久しぶりです。画像の連結の際にはうまく回答できず、すみませんでした。


早速やってみたのですが、お二人とも、同じ人以外のときも色が塗られてしまいまして。

同じ名前が2人以上のときのみ、色を塗っていただきたいのです。それ以外は塗らなくて結構です。ちょっと質問の仕方がまずかったかと思います。

恐れ入りますがよろしくお願いいたします。


3 ● SALINGER
●100ポイント ベストアンサー

修正しました。

それと、背景が白に塗りつぶす場合も除外もついでに除外しておきました。


Sub Macro()
 Dim i As Long
 Dim j As Long
 Dim lastRow As Long
 Dim k As Long
 Dim h As Variant
 Dim l As Integer
 Dim f As Boolean
 Dim c As Integer
 
  '色の指定
 h = Array(6, 45, 35, 20, 5, 15, 16, 10, 1)
 
 lastRow = Cells(Rows.Count, 1).End(xlUp).Row
 
 For i = 1 To lastRow
 k = i
 For j = i + 1 To lastRow
 If Cells(i, "F").Value = Cells(j, "F").Value Then
 If j <> i + 1 Then
 Rows(j).Cut
 Rows(i + 1).Insert Shift:=xlDown
 End If
 i = i + 1
 End If
 Next j
 If k < i Then
 l = l + 1
 If l <= UBound(h) + 1 Then
 Range("A" & k & ":F" & i).Interior.ColorIndex = h(l - 1)
 Else
 Do
 f = False
 c = c + 1
 If c = 2 Then
 f = True
 Else
 For j = 0 To UBound(h)
 If h(j) = c Then
 f = True
 Exit For
 End If
 Next
 End If
 Loop While f
 Range("A" & k & ":F" & i).Interior.ColorIndex = c
 End If
 End If
 Next i
End Sub
◎質問者からの返答

ありがとうございました!きちんと動きました。いつもありがとうございます。優しいSALINGERさんにいつも救われております。本当に感謝しております。


4 ● iimmrr
●20ポイント

大変僭越ながら、コメントさせて頂きます。

人名でソートなど、マクロを使わなくても、エクセルのソート機能を使い、一瞬でできると思います。

どのバージョンのエクセルか分かりませんが[データ]→[オートフィルタ]で、矢印ができますので、

その矢印を押して、データのソートはできますし、できなくても「A→Z」等のアイコンがあるので、

データがすべてはいっている範囲(データの左上から右下)を選択して、さっきの「a→Z」というボタンを押し、

メニューに沿って処理すれば、並び替えは簡単にできます。

詳細な使い方は、申し訳ありませんが、ググって下さい。

ググれば、理解するのに1時間もかかりません。

ググれなくてもモガイダンスにしたがって操作すればいいです。

それぐらい簡単な処理は、自分でやってから、お話した方がいいと思うのです。

さらに言うなら、2行以上名前がかぶっているというのも、すぐにエクセル関数で、出せると思います。

そこまでやって、色を塗りたいのですが、やってください、と言うと、とても効率がいいと思います。

できることをやってからの方が質問しても、いい結果が返ってくると思います。

そうしていただけば、回答する人もしやすいかと思います。

そんなことよりも、私は黙々とソース書いている人を見て、「あーなんて、この人たちはすばらしいのだろう。こういう人が世の中にたくさんいるから、世の中が動いているでしょうね。」と一種の感動を覚えました。

◎質問者からの返答

もちろん、データの並び替え等くらいは私でもできます。ただ、毎日同じ処理をするのですから、そのの1分1秒を節約したいのです。そして、今回ご回答いただける方々はいつもご協力してくださっている方々でして。こちらとしてもご回答いただいているお二人を大変信用しております。アドバイスは嬉しいのですが、マクロ部分は割りきってお願いしているのです。大変良いできばかりですし、非常に助かっております。また、無料ではなくきちんとわずかですがお礼を渡せるのが「はてな」のいいところだと思っています。ご指摘いただける部分はわかるのですが、そのご回答はヤフーの知恵袋やOKWAVEがより向いていると思います。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ