[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『重複レコードにチェックを入れる方法』（qq11qqq）
数多くのデーターの中から、以下のように同系統のデータが有る場合に、ABC列に○×をつけたいのてすが、どのようにしたらいいのでしょうか。
1.「会社名」「種類」「費用」が同じで、「地点1」「地点2」が入れ替わっているレコードの重複と考え、重複する後のレコードのA列に×を入れる。
A B C 会社名 種類 地点１ 地点２ 費用
○○社 001 福岡 東京 \50,000 ○○社 001 東京 福岡 \50,000 ↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓
A B C 会社名 種類 地点１ 地点２ 費用
○○社 001 福岡 東京 \50,000 × ○○社 001 東京 福岡 \50,000
2.「会社名」「種類」「地点1」「地点2」「費用」が同じの重複レコードを、後のレコードのB列に×を入れる。
A B C 会社名 種類 地点１ 地点２ 費用
○○社 001 東京 福岡 \50,000 ○○社 001 東京 福岡 \50,000 ↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓
A B C 会社名 種類 地点１ 地点２ 費用
○○社 001 東京 福岡 \50,000 × ○○社 001 東京 福岡 \50,000
3.「会社名」「種類」「地点1」「地点2」が同じで、「費用」が異なるレコードには、両方のレコードのC列に○を入れる。
A B C 会社名 種類 地点１ 地点２ 費用
○○社 001 東京 福岡 \60,000 ○○社 001 東京 福岡 \70,000 ↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓
A B C 会社名 種類 地点１ 地点２ 費用
○ ○○社 001 東京 福岡 \60,000 ○ ○○社 001 東京 福岡 \70,000
4.「会社名」「種類」が同じで、「地点1」「地点2」が入れ替わっていて、「費用」が異なるレコードには、「地点1」「地点2」の入れ替わりを同一にし、両方のレコードのC列に○を入れる。
A B C 会社名 種類 地点１ 地点２ 費用
○○社 001 福岡 東京 \60,000 ○○社 001 東京 福岡 \70,000 ↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓
A B C 会社名 種類 地点１ 地点２ 費用
○ ○○社 001 東京 福岡 \60,000 ○ ○○社 001 東京 福岡 \70,000
どなたか教えていただけないでしょうか。
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
条件1と条件4ですが、 条件4で並べ替えをして良いなら、条件1でも構わないですか？
つまり並べ替えを先に実施すれば、条件2と条件3の判断だけでいいと思うのですが。
先に並べ替えしてもよいでしょうか？ （稲葉） 2014/10/27(月) 09:35
たたき台
新しいシートに出力します。
Option Explicit
Sub ts()
Dim tbl
Dim i
Dim s1 As String, s2 As String
Dim con As String
tbl = Range("A1", Cells(Rows.Count, "H").End(xlUp)).Value
'//地点を並べ替え
For i = 1 To UBound(tbl, 1)
s1 = tbl(i, 6): s2 = tbl(i, 7)
If StrCmp(s1, s2) Then
tbl(i, 6) = s2
tbl(i, 7) = s1
End If
Next i
'//会社名～地点２までを一つの文字列として比較し、同じなら費用を比較する
Dim dic As Object
Dim ii As Long
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tbl, 1)
con = ""
For ii = 4 To 7 '//会社名から地点２まで
con = con & Chr(2) & tbl(i, ii)
Next ii
If Not dic.exists(con) Then
dic.Add con, CreateObject("Scripting.Dictionary")
dic(con).Add tbl(i, 8), "" '//費用追加
Else
If dic(con).exists(tbl(i, 8)) Then '//費用の比較
tbl(i, 2) = "×"
Else
tbl(i, 3) = "○"
End If
End If
Next i
'新しいシートを追加して出力
With Sheets.Add
.Range("A1").Resize(UBound(tbl, 1), UBound(tbl, 2)).Value = tbl
'//0から始まる数値文字列対応（必要なければ消す）
With .Range("E1").Resize(UBound(tbl, 1) - 1).Offset(1)
.Value = Evaluate("IF(ROW(1:" & UBound(tbl, 1) & "),""'"" & RIGHT(""00""&" & .Address & ",3))")
End With
End With
End Sub
Function StrCmp(ByVal str1 As String, ByVal str2) As Boolean
'//str1の方が大きい場合、True
'//違う文字で合計数値が同じになることってどのくらいありますかね・・・
Dim i As Long
Dim c1 As Long, c2 As Long
For i = 1 To Len(str1)
c1 = c1 + AscW(Mid(str1, i, 1))
Next i
For i = 1 To Len(str2)
c2 = c2 + AscW(Mid(str2, i, 1))
Next i
If c1 > c2 Then
StrCmp = True
Else
StrCmp = False
End If
End Function
（稲葉） 2014/10/27(月) 10:33
あらもう解決済？ http://oshiete.goo.ne.jp/qa/8803407.html?from=qa （稲葉） 2014/10/27(月) 11:24
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.