两张不同但存在关系的表进行比较

ashengz86 · 发表于 2012-12-13 16:17

附件中的两个电子表A和 B为正确的表，测试时需要自行修改，表C为最后希望得到demo 。
两个表的关系是：当A中单个ID后面的单元格（除去姓名列，C列到J列）有内容的时候，B中就应该为1（注意他们每列的列头表达方式不一样），A中没内容的单元格在B中对应的就应该为0。
目的：将两个表进行比较，例如：假设ID：12003中，E7 G7单元格在表B中实际为0，则ID号显示为红色，E7 G7单元格显示为黄色。见表C 。
也就是说 B中按照A2：F2和ID号在表A中查找，当表B的单元格为1的时候，A中C-J列就应该对应的有内容，没有内容的话，将表A的A列中有问题的ID号单元格标为红色，将此ID下未匹配上的单元格表位黄色。见表C 。

zhaogang1960 · 发表于 2012-12-13 17:20

A工作簿和B工作簿列数不同，请说明是怎么对应的

ashengz86 · 发表于 2012-12-13 17:25

zhaogang1960 发表于 2012-12-13 17:20
A工作簿和B工作簿列数不同，请说明是怎么对应的

对的！能否按照其中的关键字：Q4 Q10之类的进行对应，如果不行，那我就手动修改，让其一致

zhaogang1960 · 发表于 2012-12-13 17:30

ashengz86 发表于 2012-12-13 17:25
对的！能否按照其中的关键字：Q4 Q10之类的进行对应，如果不行，那我就手动修改，让其一致

Q4_10_other Q4_10_other-code1 Q10_06_other Q10_06_other-code1 Q10_95_other Q10_95_other-code1 Q10_96_other Q10_97_other

SQ4 Q10_6 Q10_95 Q10_96 Q10_97
一、列数不同
二、很难对应
请说明要比较的列是谁对谁即可

ashengz86 · 发表于 2012-12-13 17:36

zhaogang1960 发表于 2012-12-13 17:30
Q4_10_other Q4_10_other-code1 Q10_06_other Q10_06_other-code1 Q10_95_other Q10_95_other-code1 Q10_ ...

Q4_10_other       Q4_10_other-code1  对SQ4
Q10_06_other       Q10_06_other-code1       对Q10_6
Q10_95_other       Q10_95_other-code1       对Q10_95
Q10_96_other 对Q10_96
Q10_97_other 对Q10_97

如果编写代码时不容易匹配的话，我可以手动把前者都改成后者

zhaogang1960 · 发表于 2012-12-13 17:56

ashengz86 发表于 2012-12-13 17:36
Q4_10_other Q4_10_other-code1 对SQ4
Q10_06_other Q10_06_other-code1 对Q10_ ...

Sub Macro1()
Dim cnn, rs, SQL$, arr, i&, j&
Set cnn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.Recordset")
cnn.Open "provider=Microsoft.ACE.OLEDB.12.0;extended properties=excel 12.0;data source=" & ThisWorkbook.Path & "\B.xlsx"
SQL = "select b.SQ4,b.SQ4,b.Q10_6,b.Q10_95,b.Q10_96,b.Q10_97 from [Excel 12.0;Database=" & ThisWorkbook.FullName & "].[Sheet1$] a left join [Sheet1$] b on a.ID=b.SERIAL"
rs.Open SQL, cnn, 1, 3
Cells.Interior.Pattern = xlNone
arr = [a1].CurrentRegion
For i = 2 To UBound(arr)
For j = 3 To 8
If (Len(arr(i, j)) > 0 And rs.Fields(j - 3).Value = 0) Or (Len(arr(i, j)) = 0 And rs.Fields(j - 3).Value = 1) Then
Cells(i, j).Interior.Color = 65535
Cells(i, 1).Interior.Color = 192
End If
Next
rs.MoveNext
Next
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub

复制代码

zhaogang1960 · 发表于 2012-12-13 17:57

请看附件

wenti1213.rar (23.04 KB, 下载次数: 17)

ashengz86 · 发表于 2012-12-13 23:04

zhaogang1960 发表于 2012-12-13 17:57
请看附件

赵老师非常感谢！这个方法太高深~但是考虑到它的列头的不一致，为了避免出现其他人为因素所导致的不准确，我将两个表规范了一下，并放在同一个worksheet里。请看下面的附件。同时我写的小程序有两方面的问题，1.处理时间太长导致卡死（因此在程序里只限制了99行），2.A列有问题的ID号无法变成红色，请您帮我再处理一下，我也会对比学习一下的

ashengz86 · 发表于 2012-12-13 23:06

本帖最后由 ashengz86 于 2012-12-13 23:11 编辑

sheet1 为期望得到的结果以第七行为例：在sheet2中 B7是0，而sheet1中B7不应有内容，同理当sheet2其他的单元格为1时，sheet1相同位置的单元格应存在内容，未有内容则标记为黄色。实际中列有很多，只是提供了极小部分内容

LMY123 · 发表于 2018-8-24 10:53

SQL = "select b.SQ4,b.SQ4,b.Q10_6,b.Q10_95,b.Q10_96,b.Q10_97 from [Excel 12.0;Database=" & ThisWorkbook.FullName & "].[Sheet1$] a left join [Sheet1$] b on a.ID=b.SERIAL"

		自动登录	找回密码
密码			免费注册

两张不同但存在关系的表进行比较

评分