如何根据纵横向之和与各分项之差校对数据

zhusong1998

microyip 发表于 2018-8-21 09:58
实际上，数独规则跟你目前需求的规则是一样的，都是要求横竖数值和一致，不同的是，你横竖数值和不固定， ...

数独，这个太难了，准备打退堂鼓了
多谢提供思路~~

microyip

假如是找出位置是不难的，假如要核对数据，可能就麻烦点

microyip

查找位置

针对表1形式

1. Sub 表1查找错误位置()
   
2.     Dim vData As Variant, nRow As Integer, nCol As Integer
   
3.     Dim rRng As Range
   
4.    
   
5.     vData = [B18:J30]
   
6.     For nRow = 2 To UBound(vData) - 1
   
7.         If vData(nRow, 9) <> 0 Then
   
8.             For nCol = 2 To UBound(vData, 2) - 1
   
9.                 If vData(13, nCol) <> 0 And IsEmpty(vData(nRow, nCol)) Then
   
10.                     If rRng Is Nothing Then
    
11.                         Set rRng = [B18].Offset(nRow - 1, nCol - 1)
    
12.                     Else
    
13.                         Set rRng = Union(rRng, [B18].Offset(nRow - 1, nCol - 1))
    
14.                     End If
    
15.                 End If
    
16.             Next
    
17.         End If
    
18.     Next
    
19.     If Not rRng Is Nothing Then rRng.Interior.Color = 255
    
20. End Sub

复制代码

针对表2查找

1. Sub 表2查找错误位置()
   
2.     Dim vData As Variant, nRow As Integer, nCol As Integer
   
3.     Dim rRng As Range
   
4.    
   
5.     vData = [B34:I45]
   
6.     For nRow = 2 To UBound(vData)
   
7.         For nCol = 2 To UBound(vData, 2)
   
8.             vData(nRow, 1) = vData(nRow, 1) - vData(nRow, nCol)
   
9.             vData(1, nCol) = vData(1, nCol) - vData(nRow, nCol)
   
10.         Next
    
11.     Next
    
12.     For nRow = 2 To UBound(vData)
    
13.         If vData(nRow, 1) <> 0 Then
    
14.             For nCol = 2 To UBound(vData, 2)
    
15.                 If vData(1, nCol) <> 0 And IsEmpty(vData(nRow, nCol)) Then
    
16.                     If rRng Is Nothing Then
    
17.                         Set rRng = [B34].Offset(nRow - 1, nCol - 1)
    
18.                     Else
    
19.                         Set rRng = Union(rRng, [B34].Offset(nRow - 1, nCol - 1))
    
20.                     End If
    
21.                 End If
    
22.             Next
    
23.         End If
    
24.     Next
    
25.     If Not rRng Is Nothing Then rRng.Interior.Color = 255
    
26. End Sub

复制代码

microyip

附上附件以供参考

microyip

还是有疏漏的错误，哈哈

zhusong1998

microyip 发表于 2018-8-21 14:53
查找位置

针对表1形式

非常感谢帮助，我好好研学下。

zhusong1998

microyip 发表于 2018-8-21 15:00
还是有疏漏的错误，哈哈

是啊，7班只有两个单元格漏了数据，但却标注了三个，这是为什么呢，没有看出来哪儿的代码有问题，望完善一下~~

microyip

表2找位置的更新，思路可能需要优化，但暂时只能想出这个笨方法

1. Sub 表2查找错误位置()
   
2.     Dim vData As Variant, vRow As Variant, vCol As Variant
   
3.     Dim dicRow As Object, dicCol As Object, dicEmpty As Object, vKey As Variant
   
4.     Dim rRange As Range, rStart As Range
   
5. 
   
6.     Set dicRow = CreateObject("Scripting.Dictionary")
   
7.     Set dicCol = CreateObject("Scripting.Dictionary")
   
8.     Set dicEmpty = CreateObject("Scripting.Dictionary")
   
9.     Set dicEmpty(0) = CreateObject("Scripting.Dictionary") '行的空格数
   
10.     Set dicEmpty(1) = CreateObject("Scripting.Dictionary") '列的空格数
    
11.    
    
12.     Set rStart = [B34]
    
13.     vData = rStart.Resize(12, 8).Value
    
14.     For vRow = 2 To UBound(vData)
    
15.         For vCol = 2 To UBound(vData, 2)
    
16.             vData(vRow, 1) = vData(vRow, 1) - vData(vRow, vCol)
    
17.             vData(1, vCol) = vData(1, vCol) - vData(vRow, vCol)
    
18.             If IsEmpty(vData(vRow, vCol)) Then
    
19.                 dicRow(vRow) = dicRow(vRow) + 1
    
20.                 dicCol(vCol) = dicCol(vCol) + 1
    
21.             End If
    
22.         Next
    
23.     Next
    
24.    
    
25.     For Each vRow In dicRow.Keys
    
26.         For Each vCol In dicCol.Keys
    
27.             If vData(vRow, 1) > 0 Then dicEmpty(0)(dicRow(vRow)) = dicEmpty(0)(dicRow(vRow)) & "|" & vRow & "," & vCol
    
28.             If vData(1, vCol) > 0 Then dicEmpty(1)(dicCol(vCol)) = dicEmpty(1)(dicCol(vCol)) & "|" & vRow & "," & vCol
    
29.             If vData(vRow, 1) > 0 And vData(1, vCol) > 0 And IsEmpty(vData(vRow, vCol)) Then
    
30.                 dicEmpty(vRow & "," & vCol) = 0
    
31.                 If rRange Is Nothing Then
    
32.                     Set rRange = Cells(rStart.Row - 1 + vRow, rStart.Column - 1 + vCol)
    
33.                 Else
    
34.                     Set rRange = Union(rRange, Cells(rStart.Row - 1 + vRow, rStart.Column - 1 + vCol))
    
35.                 End If
    
36.             End If
    
37.         Next
    
38.     Next
    
39.    
    
40.     rStart.Offset(1, 1).Resize(11, 7).Interior.Color = xlNone
    
41.     If Not rRange Is Nothing Then rRange.Interior.Color = 255
    
42. End Sub

复制代码

microyip

附上附件以供参考，针对表2进行调整，位置找得出来，但填数方面，只能用数独方法。因为碰巧是一个挨一个的能逐个通过填只有一个数的行或列方式的话，还好办，否则，我也爱莫能助，始终在这方面没研究过，也没细想过，总的来说，我有自知之明，没这样的逻辑

zhusong1998

microyip 发表于 2018-8-23 09:20
附上附件以供参考，针对表2进行调整，位置找得出来，但填数方面，只能用数独方法。因为碰巧是一个挨一个的 ...

不填数了，能找出来错误的位置，对我来说已是最大的幸运了
感谢帮助，小花两朵，不成敬意~~

7班的标注还是有问题，仍标注三个单元格有错误。