A列のA2からA21に氏名、B列のB2からB21に住所が入力済です。A列で重複しているデータに色をつけて、さらに並び替えをしたいと思います。色は黄色、並び替えの設定は黄色で色を付けたセルがA2から順に表示するVBAを教えていただけませんでしょうか。またお手数でも列をB列、C列に変更した場合についても教えていただけませんでしょうか。VBAコードの貼り付けはできます。よろしくお願いします。

このQ&Aに関連する最新のQ&A

A 回答 (3件)

こんにちは!


一例です。

Sub test()
Dim i As Long
Range("A2:B21").Sort key1:=Cells(2, 1), order1:=xlAscending
Columns("A").Insert
For i = 2 To 21
If WorksheetFunction.CountIf(Columns("B"), Cells(i, "B")) > 1 Then
Range(Cells(i, "B"), Cells(i, "C")).Interior.ColorIndex = 6
Cells(i, "A") = i
Else
Cells(i, "A") = WorksheetFunction.CountA(Columns("B")) + i
End If
Next i
Range("A2:C21").Sort key1:=Cells(2, "A"), order1:=xlAscending
Columns("A").Delete (xlToLeft)
End Sub

こんな感じではどうでしょうか?
コード内にデータとは関係ない列番号「C」が入っていますが、気になれば最後の行
Columns("A").Delete (xlToLeft)
を削除してマクロを試してみてください。

参考になれば良いのですが・・・m(__)m
    • good
    • 1
この回答へのお礼

早速の回答ありがとうございました。詳細のコードを記載していだだき感謝です。記載していだだいたVBAをお手本にしてやってみます。ご指導ありがとうございました。

お礼日時:2011/04/26 11:54

VBAの一例です。


表の範囲を変えるなら、Range("A2:B21") のところを変更してください。
なお、以下のコードは、並び替えのため表の右となりの一列を作業列に使用してますので、表の右となりの一列は空白にして置いてください。

Sub Sample01()
  Dim Rng As Range, c As Range, c2 As Range
  Dim n As Long, i As Long
  Set Rng = Range("A2:B21").Columns
  For Each c In Rng(1).Cells
    n = 0
    For Each c2 In Rng(1).Cells
      If c.Value = c2.Value Then
        n = n + 1
        If n > 1 Then
          c.Resize(, 2).Interior.ColorIndex = 6
          c2.Resize(, 2).Interior.ColorIndex = 6
          i = i + 1
          If IsEmpty(c.Offset(, 2)) Then
            c.Offset(, 2) = i
          End If
          If IsEmpty(c2.Offset(, 2)) Then
            c2.Offset(, 2) = i
          End If
        End If
      End If
    Next c2
  Next c
  Rng.Resize(, 3).Sort Key1:=Rng(2).Offset(, 1).Cells(1), Order1:=xlAscending, Header:=xlNo
  Rng(2).Offset(, 1).ClearContents
End Sub
    • good
    • 0
この回答へのお礼

回答、誠にありがとうございました。詳細なコードを記載していただきお手数をおかけしました。コードを参考に勉強します。時間をかけてやってみます。

お礼日時:2011/04/26 11:50

あまり勉強もしないで丸投げしているようだ。


>列をB列、C列に変更した場合についても教えていただけませんでしょうか
など言っているレベルでは、現状では、VBAは無理でしょう。
VBAを使わないでも、条件付書式で出来るのでは。
A2:A10など範囲指定
書式ー条件付書式ー数式がー式は =COUNTIF($A$2:A2,A2)>1
書式を設定
これで重複する氏名で2番目以後の行に色をつけられる。

上記の操作をマクロの記録で取る方法もある。
ーー
条件付書式を離れて
下記は要素的にはマクロの記録を採れば判る。
(1)セルに色を着ける
(2)黄色とかの色指定
(3)並べ替え
 ただし重複チェックはエクセルの操作ではない。上記のように関数では出来る。これを関数を使わず、VBAプログラムでやるのは、VBAでも中級以上のレベルでしょう。
    • good
    • 0
この回答へのお礼

早速の回答ありがとうございました。条件書式を参考に勉強します。たいへんお手数をおかけしました。

お礼日時:2011/04/26 11:47

このQ&Aに関連する人気のQ&A

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

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

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Q車の色の名前の一覧を探してます!

自動車の色の名前は、ウイニングブルーメタリック、カナリーイエローマイカなど独特なカタカナ名が多いですが、このような名前が一覧になっているようなHPを探しています。ありましたらどなたか教えてください。

Aベストアンサー

ここで探して下さい。

参考URL:http://www.soft99.co.jp/

QA列とB列の重複を抽出したいのですがA列とB列の値は一部だけ同じ文字です。ご教示お願いします。

エクセル初心者です。重複を見つけるのが仕事です。いろいろやってみたのですがうまくできません。
お知恵をお貸しください。

A列には企業名が入力されています。
B列にも企業名が入力されていますが全く同じ文字ではないのです。

たとえばこういうことです。
A1 (有)雪見酒      B1  雪見
A2 株式会社豪雪地帯   B2 (株)豪雪地帯
A3 ゆきかき本舗     B3 (有)ゆきかき本舗

A列にある企業名とB列にある企業名が同じであればセルを塗りつぶすか○を表示させるように
したいのです。
重複を見つけるのが目的なので、ほかの方法でもかまいません。
すみません、A列のセルとB列のセルが全く同じ名前ならば重複が見つけられたのですが
ここから先がどうしてもわからないのです。。。
申し訳ありませんがどうか教えてください。。。

Aベストアンサー

No4です。以下のマクロを標準モジュールへ登録してください。
--------------------------------------------------
Option Explicit
Public Sub 重複チェック()
Dim maxrow1 As Long
Dim maxrow2 As Long
Dim row1 As Long
Dim row2 As Long
Dim nameT1() As String
Dim nameT2() As String
Dim t1, t2 As Variant
t1 = Time
maxrow1 = Cells(Rows.Count, "A").End(xlUp).row '最大行取得
maxrow2 = Cells(Rows.Count, "B").End(xlUp).row '最大行取得
ReDim nameT1(maxrow1)
ReDim nameT2(maxrow2)
Range("C1:" & "D" & maxrow2).Value = ""
Call makeTable(nameT1, "A", maxrow1)
Call makeTable(nameT2, "B", maxrow2)
For row1 = 1 To maxrow1
For row2 = 1 To maxrow2
If Cells(row2, "C") = "" Then
If Mymatch(nameT1(row1), nameT2(row2)) = True Then
Cells(row2, "C").Value = "○"
Cells(row2, "D").Value = row1
End If
End If
Next
Next
t2 = Time
MsgBox ("チェック完了 処理時間=" & Minute(t2 - t1) & "分" & Second(t2 - t1) & "秒")
End Sub
'余分な文字を削除した結果をテーブルに格納する
Private Sub makeTable(ByRef nameT() As String, ByVal col As String, ByVal maxrow As Long)
Dim row As Long
Dim ary As Variant
Dim name As String
Dim i As Long
ary = Array("㈱", "(株)", "株式", "(有)", "有限", "会社")
For row = 1 To maxrow
name = Cells(row, col).Value
For i = 0 To UBound(ary)
name = Replace(name, ary(i), "")
Next
nameT(row) = name
Next
End Sub
'企業名が一致かどうか判定する
Private Function Mymatch(ByVal name1 As String, ByVal name2 As String) As Boolean
Mymatch = False
Dim pos As Variant
pos = InStr(1, name1, name2, vbTextCompare)
If pos > 0 Then Mymatch = True
End Function
-----------------------------------------------------
一致の精度が悪ければその旨補足してください。
(一致すべきものが一致しない、一致してはいけないものが一致している)
100%解決できる保証はありませんが、多少のチューニングは行います。

No4です。以下のマクロを標準モジュールへ登録してください。
--------------------------------------------------
Option Explicit
Public Sub 重複チェック()
Dim maxrow1 As Long
Dim maxrow2 As Long
Dim row1 As Long
Dim row2 As Long
Dim nameT1() As String
Dim nameT2() As String
Dim t1, t2 As Variant
t1 = Time
maxrow1 = Cells(Rows.Count, "A").End(xlUp).row '最大行取得
maxrow2 = Cells(Rows.Count, "B").End(xlUp).row '最大行取得
ReDim ...続きを読む

Qファイル一覧の項目の色について

ディスクを開くとフォルダゃファイルの一覧が表示されますが、この一覧の各項目名というか表題というか、この表示される名前に色はつけられないものなのでしょうか、色分けできればわかりやすいので、教えていただきたいのですが。

Aベストアンサー

explorerだけではできそうにない。
いろいろなツールがフリーソフトである。


たとえば、
http://homepage3.nifty.com/pyxis/

Qシート1のA列にある会社名を探してB列にある住所が入力されたら、シート2のB列に○を付けたい

シート1
A列        B列
株式会社A     東京都町田市…
株式会社B     
株式会社C     北海道札幌市…
↓↓↓↓↓
シート2
A列        B列
株式会社C     ○
株式会社A     ○
株式会社B

上記のように表示したいです。
できれば、関数でできれば助かります。

追加:シート2の会社名はシート1の会社名と順番が違います。

よろしくお願いします。

Aベストアンサー

こんばんは!

↓の画像でSheet2のB2セルに
=IFERROR(IF(VLOOKUP(A2,Sheet1!A:B,2,0)<>"","○",""),"")
という数式を入れフィルハンドルで下へコピーしています。m(_ _)m

Q「名前をつけて保存」のデフォルト表示形式を「一覧」以外に変えられますか?

MS-Office以外のアプリケーションで「名前をつけて保存」を選択した際の、
ダイアログウィンドウ内の表示形式を変えられますか?

「詳細」「一覧」「アイコン表示」「並べて表示」「縮小版」
などの選択肢を一定のものに変えたいのです。
(現状では、毎回「名前をつけて保存」を開くたびに「一覧」表示に戻ってしまうようです)

OSはWindows-XPです。

Aベストアンサー

Windows標準の機能(フォルダオプションなど)では出来ませんが
http://okazaki.incoming.jp/matatabi/
のFasieと言うフリーSOFTを使えば出来ます。

http://okazaki.incoming.jp/danpei2/software/fasie.htm
http://pasokoma.jp/39/lg390467#390654

QExcel2013 VBA A列とB列の文字をA列とB列とC列に移動させる方法

A列とB列に文字が入っているのですが、下記のようにA列とB列とC列に文字を移動させたいです。
(A列の数字は必ず奇数のA列に入っています。)
VBAのコードを教えて下さい。

例えば
A1 1  B1 cat
A2 空白 B2 猫
A3 空白 B3 dog
A4 空白 B4 犬
A5 2  B5 whale
A6 空白 B6 クジラ
A7 3  B7 rabbit
A8 空白 B8 ウサギ

とデータがある場合

A1 1  B1 cat  C1 猫
A2 空白 B2 dog  C2 犬
A3 2  B3 whale  C3 クジラ
A4 3  B4 rabbit C4 ウサギ

としたいです。

実際、データは、A5196まであります。

Aベストアンサー

No.1です。

>実際、データは、A5196まであります。

前回のコードは一つずつカット&ペーストしていますので
かなりの時間を要すると思います。
↓のコードに変更してみてください。

Sub Sample2()
Dim lastRow As Long
lastRow = Cells(Rows.Count, "B").End(xlUp).Row
Application.ScreenUpdating = False
With Range(Cells(1, "C"), Cells(lastRow, "C"))
.Formula = "=IF(MOD(ROW(),2)=1,B2,"""")"
.Value = .Value
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Application.ScreenUpdating = True
MsgBox "完了"
End Sub

少しは短縮できると思います。m(_ _)m

No.1です。

>実際、データは、A5196まであります。

前回のコードは一つずつカット&ペーストしていますので
かなりの時間を要すると思います。
↓のコードに変更してみてください。

Sub Sample2()
Dim lastRow As Long
lastRow = Cells(Rows.Count, "B").End(xlUp).Row
Application.ScreenUpdating = False
With Range(Cells(1, "C"), Cells(lastRow, "C"))
.Formula = "=IF(MOD(ROW(),2)=1,B2,"""")"
.Value = .Value
.SpecialCells(xlCellTypeB...続きを読む

QAccessで指定する色数値の一覧ありませんか?

MsAccess 2002でフォームを作成しているのですが、フォームの色指定に使える色数値の一覧表はどこかにありませんでしょうか?

VBAを使いRGB関数で指定しても期待したとおりの色を取得することができません。
Accessで使用できる色数値の一覧を参照できるページなどご存知の方いらっしゃいましたらよろしくお願いします。

Aベストアンサー

#1です。先程のページの最後に「このホームページで表示している色は近似色です。正確な色ではありませんので御注意下さい。」と書いてありますので、もしかしたらうまく同じ色が出ないかも知れないですね。
とりあえずカラーチャートのリンク集がありましたので見てみて下さい。
http://www2u.biglobe.ne.jp/~color/all/l_02a_chart.htm

参考URL:http://www2u.biglobe.ne.jp/~color/all/l_02a_chart.htm

Q例えば、AさんからGさんまでがA列に縦に並んでいてB列に数字が入っています。B列にある数字の合計をA

例えば、AさんからGさんまでがA列に縦に並んでいてB列に数字が入っています。B列にある数字の合計をA-Gさん別々に出したいんですが簡単なvbaの記述方法はないでしょうか?
お願いします。

Aベストアンサー

こんばんは!

A列のA~Gさんは複数存在しているのでしょうか?
そうであればSUMIF関数で対応できると思いますが、VBAをお望みだというコトですので
一例です。

元データはSheet1にあり、Sheet2に表示するとします。
尚、Sheet1の1行目は項目行でデータは2行目以降にあるという前提です。
標準モジュールにしてください。

Sub Sample1()
Dim lastRow As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Cells.ClearContents
With Worksheets("Sheet1")
.Range("A:A").AdvancedFilter Action:=xlFilterCopy, copytorange:=wS.Range("A1"), unique:=True
lastRow = wS.Cells(Rows.Count, "A").End(xlUp).Row
With Range(wS.Cells(2, "B"), wS.Cells(lastRow, "B"))
.Formula = "=SUMIF(Sheet1!A:A,A2,Sheet1!B:B)"
.Value = .Value
End With
End With
End Sub

こんな感じではどうでしょうか?m(_ _)m

こんばんは!

A列のA~Gさんは複数存在しているのでしょうか?
そうであればSUMIF関数で対応できると思いますが、VBAをお望みだというコトですので
一例です。

元データはSheet1にあり、Sheet2に表示するとします。
尚、Sheet1の1行目は項目行でデータは2行目以降にあるという前提です。
標準モジュールにしてください。

Sub Sample1()
Dim lastRow As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Cells.ClearContents
With Worksheets("Sheet1")
.Range("A:A...続きを読む

Q一覧にある名前に該当する名前を赤くしたいのですが…

こんばんわ、いつもお世話になっています。

Excelのシートで
「シート1」に名前一覧を作り、「シート2」に名前を入れていくと「シート1」に名前がある人を入力すしたとき入力した文字を赤くしたり太字させることは可能ですか?

Aベストアンサー

Sheet1のA列を全て選択して、挿入-名前-定義で適当な名前を付けます。(例 リスト)
Sheet2のA列を全て選択して、書式-条件付き書式で「数式が」にして

=NOT(ISERROR(MATCH(A1,リスト,0)))

と入力し、書式を設定します。

これで希望のようになりますか?

QエクセルのA列とB列で重複するレコードのみを抽出して別の列に表示させた

エクセルのA列とB列で重複するレコードのみを抽出して別の列に表示させたい。

エクセルのA列に約1,000行くらいのデータが有ります。
このA列内で重複レコードがあります。
B列に約1,000行くらいのデータが有ります。
B列内でも重複レコードが有ります。
この条件の中で

(1)A列にもB列にあるデータすべて
(2)A列にしかないデータすべて
(3)B列にしかないデータすべて
を抽出したいのですが、どんな方法がありますか?
それで
(1)をC列
(2)をD列
(3)をE列
に並べて表示させたいです。
さらに抽出されたデータで重複レコードの場合は1件のみで表示したいです。
複数の操作を繰り返すのではなく
C,D,E列に式を入れるだけで済ませる事は可能でしょうか?
よろしくお願いします。


   A   B    C   D   E
1-001-002--001--004--007
2-002-002--002--006--008
3-001-001--005--010
4-005-007
5-001-005
6-004-005
7-004-008
8-010-007
9-006-007

A列には001が3個、002が1個、005が1個有ります。
B列には001が1個、002が2個、005が2個有ります。
A列にもB列にも有るのは、001と002と005ですから
これがC列に表示されます。
でそれぞれA列にもB列にも複数有りますが、1個として判定なので

よって、C列には
001
001
001
001
002
002
005
005
と表示ではなく
001
002
005
と表示したい。

次にD列はA列に有る物だけですから
004
006
010
となります。B列には004は2個有りますが同じ値なので
004
004
006
010
では無く004は1個の表示です。

E列はB列のみのデータなので
007
008
です。
同じくB列には007が3個有りますが1個ともなします。
007
007
007
008
では無く
007
008
です。

エクセルのA列とB列で重複するレコードのみを抽出して別の列に表示させたい。

エクセルのA列に約1,000行くらいのデータが有ります。
このA列内で重複レコードがあります。
B列に約1,000行くらいのデータが有ります。
B列内でも重複レコードが有ります。
この条件の中で

(1)A列にもB列にあるデータすべて
(2)A列にしかないデータすべて
(3)B列にしかないデータすべて
を抽出したいのですが、どんな方法がありますか?
それで
(1)をC列
(2)をD列
(3)をE列
に並べて表示...続きを読む

Aベストアンサー

No.2です!
たびたびすみません。
投稿した後で質問文を読み返してみるとデータが約10000行あるということなので、
前回の数式の「1000」の部分を全て「10000」に変更してみてください。

そして余計なお世話かもしれませんが、10000行までオートフィルでコピーするのは大変でしょうから、
当方使用のExcel2003の場合ですが
もう1列A列に列を挿入します。
A2セルに「1」を入力後、A2セルをアクティブにします 
→ メニュー → 編集 → フィル → 連続データの作成 → 「列」を選択 → 「停止値」に「10000」としてOK
そして、B2~D2セルに作業列が移動しているはずですので、B2~D2セルを範囲指定し、
D2セルのフィルハンドルの(+)マークでダブルクリック
10000行目までコピーできますが、少し時間がかかると思います。
最後にA列全てを削除します。

以上、何度もごめんなさいね。m(__)m


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報