Excel VBAについての質問です｡ プログラム上で､オートフィルタを使い､写真のように名前(田中

Excel VBAについての質問です｡
プログラム上で､オートフィルタを使い､写真のように名前(田中)とクラス(1)を絞り込み､絞り込んだ結果､入力されてるセルに色を付け､次は名前(田中)､クラス(2)と絞り込むようなプログラムを作りたいのですが､何か良い方法は無いでしょうか(説明下手ですみません…)

No.8 ベストアンサー 回答者： tom04 回答日時： 2020/05/27 17:33

No.2・4です。

＞今度は型が一致しないと出てしまいます…

最初の段階の変数の宣言部分をもう一度確認してみてください。

＞Dim lastRow As Long, lastCol As Long
のようにちゃんと長整数型（整数型のInteger型でもOK）になっていますか？m(_ _)m

この回答へのお礼

変数宣言も何度も見直してますが､やはり間違いは無いみたいです…
UserRangeを消してみたら動いて結果的には予想通り?の結果になりましたのでこれで大丈夫…みたいです?

お礼日時：2020/05/28 10:27

No.7 回答者： fujillin 回答日時： 2020/05/27 14:48

No3です

＞実際に打ち込んでみたのですが､n=UBound(colP)+1の所で配列がありませんと言われてしまいます…
こちらでは、テスト済みのコードです。
打り込むのではなく、コピペで試してみてください。

この回答へのお礼

fujillin様､申し訳ありませんでした｡変数宣言時のDim colP , nが表記ミスと思っており､抜かしていた為､エラーが起きていました｡
カラーの方は無事解決する事が出来ました｡

お礼日時：2020/05/27 15:07

No.6 回答者： tom04 回答日時： 2020/05/27 14:21

No.2．4です。

No.4・5がダブってしまいました。（「この内容で回答する」を2回クリックしてしまいました）
No.5は無視してください。m(_ _)m

No.5 回答者： tom04 回答日時： 2020/05/27 14:17

No.2です。

エラーになってしまいましたか。
＞おそらく打ちミスは無いと思います

ご自身でコードをもう一度手入力されているのですかね？
そうであればこの画面上からコードをコピー＆ペーストしてみてください。

尚、
＞lastCol = UsedRange.Columns.Count
でなくても

＞lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
でも良いと思います。m(_ _)m

No.4 回答者： tom04 回答日時： 2020/05/27 14:17

No.2です。

エラーになってしまいましたか。
＞おそらく打ちミスは無いと思います

ご自身でコードをもう一度手入力されているのですかね？
そうであればこの画面上からコードをコピー＆ペーストしてみてください。

尚、
＞lastCol = UsedRange.Columns.Count
でなくても

＞lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
でも良いと思います。m(_ _)m

この回答へのお礼

tom04様回答ありがとうございます｡
VBA自体を社内PCでやっているのですが､セキュリティの問題でネットが開けない状態でして､コピーが取れないのです｡

書き換えて見ましたが､今度は型が一致しないと出てしまいます…

お礼日時：2020/05/27 14:50

No.3 回答者： fujillin 回答日時： 2020/05/27 13:32

No1です

勝手に解釈して「A,B列ともに同じ値の行を同じ色に着色したい」ということかと仮定しました。

No2様もご指摘ですが、色数が何色必要なのか不明なので、適当に増減可能なようにしてみました。
Sampleでは、ひとまず６色としていますが、列挙を増やせばそれだけ増加します。
定義された色数が不足した場合は、最初の色に戻って使用します。

ご提示の方法とはまったく異なる方法で行っていますので、ご参考までに。
D,E列を作業用に利用していますので、既にデータが存在するような場合は作業列を移動すればよろしいでしょう。

Sub Sample_F14()
Dim colP, n As Long, rng As Range, c As Range

'//　XlRgbColorまたはRGB値を指定色数分列挙
colP = Array(rgbBisque, rgbKhaki, rgbPaleGreen, rgbPaleTurquoise, rgbLavender, rgbPink)
n = UBound(colP) + 1
Set rng = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))

rng.Offset(, 3).FormulaLocal = "=IF(COUNTIFS(A$2:A2,A2,B$2:B2,B2)=1,COUNT(D$1:D1),"""")"
rng.Offset(, 4).FormulaLocal = "=INDEX(D:D,AGGREGATE(15,6,ROW(A$2:A2)/(A$2:A2=A2)/(B$2:B2=B2),1))"

For Each c In rng.Offset(, 4)
If IsNumeric(c.Value) Then c.Offset(, -4).Resize(, 2).Interior.Color = colP(c.Value Mod n)
Next c
rng.Offset(, 3).Resize(, 2).Clear
End Sub

この回答へのお礼

おぉ!!ありがとうございます!!
実際に打ち込んでみたのですが､n=UBound(colP)+1の所で配列がありませんと言われてしまいます…

お礼日時：2020/05/27 14:42

No.2 回答者： tom04 回答日時： 2020/05/26 19:07

こんばんは！

すべての組み合わせを表示する場合、色の指定が面倒ですね。
どこかの列に色サンプルを作成しておき、順にその色で塗りつぶす！という方法だと色指定が簡単だと思います。
ただ、今回は色の件は無視してデータ表示のみにしてています。
VBAになりますが一例です。
（お示しの画像通りの配置だとします）

Sub Sample1()
　Dim myDic As Object
　Dim i As Long, k As Long, cnt As Long
　Dim lastRow As Long, lastCol As Long
　Dim myStr As String
　Dim myKey, myAry

　　Set myDic = CreateObject("Scripting.Dictionary")
　　　Application.ScreenUpdating = False
　　　　lastRow = Cells(Rows.Count, "A").End(xlUp).Row
　　　　lastCol = UsedRange.Columns.Count
　　　　　'//▼D列以降のデータを一旦消去//
　　　　　If lastCol > 3 Then
　　　　　　Range(Cells(1, "D"), Cells(lastRow, lastCol)).Clear
　　　　　End If

　　　　　'//▼ココから操作//
　　　　　For i = 2 To lastRow
　　　　　　myStr = Cells(i, "A") & "_" & Cells(i, "B")
　　　　　　　If Not myDic.exists(myStr) Then
　　　　　　　　myDic.Add myStr, ""
　　　　　　　End If
　　　　　Next i
　　　　myKey = myDic.keys
　　　　　For i = 0 To UBound(myKey)
　　　　　　cnt = cnt + 1
　　　　　　myAry = Split(myKey(i), "_")
　　　　　　　With Range("A1").CurrentRegion
　　　　　　　　.AutoFilter Field:=1, Criteria1:=myAry(0)
　　　　　　　　.AutoFilter Field:=2, Criteria1:=myAry(1)
　　　　　　　　.SpecialCells(xlCellTypeVisible).Copy Cells(1, cnt * 3 + 1)
　　　　　　　End With
　　　　　Next i
　　　　ActiveSheet.AutoFilterMode = False
　　　Application.ScreenUpdating = True
　　　　Set myDic = Nothing
End Sub

※　A・B列の出現順に表示されます。m(_ _)m

この回答へのお礼

返信遅れてすみません!!例文ありがとうございますm(*_ _)m試しに打ってみたのですが､lastCol=UsedRange.Columns.Countの所でUsedRangeの変数が定義されていないと出てくるのですが､どうしたらいいでしょうか｡(おそらく打ちミスは無いと思います…)

お礼日時：2020/05/27 09:38

No.1 回答者： fujillin 回答日時： 2020/05/26 11:48

こんにちは

なさりたいことが正確にはわかりませんが（質問者様はわかっているでしょうから）、ご質問文に記載の手順でできると思いますよ。

＞何か良い方法は無いでしょうか
（質問文によれば）オートフィルタで抽出し、そのセル（範囲）に背景色を設定。
という手順でよいのではないでしょうか？
（オートフィルタを使わずにループで抽出という方法も考えられますが…）
VBAとのことですから、ほとんどそのままをVBA化すれば宜しいでしょう。

何らかの元になるコードが欲しいのであれば、「マクロの記録」を取ればほぼそのままのものを得ることができます。

この回答へのお礼

返事遅れてすみません!!なるほど…実際にマクロ記録を試してみましたがこんな機能があったとは…
ありがとうございます!!m(*_ _)m今回に限らずに今後も使えそうですね

お礼日時：2020/05/27 09:05