[已解决]哪位大神可以保留2个57？

grf1973

如果每行找出一对的话，可用字典解决。

1. Sub grf()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Set d1 = CreateObject("scripting.dictionary")
   
4.     arr = [a1].CurrentRegion
   
5.     For i = 1 To UBound(arr)
   
6.         For j = 1 To UBound(arr, 2)
   
7.             x = arr(i, j)
   
8.             If Len(x) >= 2 Then
   
9.                 For m = 1 To Len(x) - 1
   
10.                     For n = m + 1 To Len(x)
    
11.                         xkey = Mid(x, m, 1) & Mid(x, n, 1)   '两位数的组合
    
12.                         d(xkey) = d(xkey) + 1     '不同两位数出现的次数
    
13.                         d1(xkey) = d1(xkey) & "," & Cells(i, j).Address       '不同两位数所在的单元格地址
    
14.                     Next
    
15.                 Next
    
16.             End If
    
17.         Next
    
18.         For Each xkey In d.keys
    
19.             If d(xkey) = 2 Then
    
20.                 rg = Mid(d1(xkey), 2)
    
21.                 Range(rg).Font.Size = 36
    
22.                 Range(rg) = xkey
    
23.                 Exit For   '最多只找一对
    
24.             End If
    
25.         Next
    
26.         d.RemoveAll
    
27.         d1.RemoveAll
    
28.     Next
    
29. End Sub

复制代码

lingyuncelia1

lichuanboy44 发表于 2016-2-23 12:57
原代码错误的原因是将 "*" & a & "*" & "b" & "*")中的b加了双引号，
但即使你把数字通过复制后粘贴变 ...

谢谢大神，我现在才注意到原来我多写了b的双引号。不过我设置b的时候是b=a+1,因此是不会出现11之类的重复数，
我用如下代码试过：
Sub c()
For a = 1 To 4
For b = a + 1 To 5
MsgBox a & b
  Next
  Next
End Sub
所以知道如果代码改为：
Sub c()
For a = 1 To 8
For b = a + 1 To 9
MsgBox a & b
  Next
  Next
End Sub
出现的数组是：12--19；23--29；34--39；45--49；56--59；67--69；78--79；89
我要的就是这串数。这串数里的其中有2个数字可以合在一起出现在同一单元格，如12，也可以在同一单元格分开出现，如：139.每个单元格的数字都是按升序排列，且不会重复。例如：红色字体的排列，后者比前者大。2>1,9>3>1.

lingyuncelia1

谢谢大侠的宝贵意见，其实提出这个问题，是为了写出数独游戏的隐含数对法。这个是隐含数对法中的同行隐含数对法，即同一行有9个单元格，每个单元格的数字都是升序排列，且绝不重复。在同一行里，数字由1到9，如果其中有2个数字都出现2次，且每次都是一起出现在同一格里，即为所求数。之前已经用过字典、正则之类的。可惜数据一变，又变得不符合要求。现附件已上传个人自制的数独游戏，君可试玩，能更明显清楚是什么回事。除了隐含数对法部分功能受限制，其它均试验成功。该游戏只有唯一解，我已用暴力破解验算过了。

lingyuncelia1

lichuanboy44 发表于 2016-2-23 09:12
此问题好像已看过一次了，不知这样有可用
Sub 处理()
  a = 5

谢谢大侠的宝贵意见，其实提出这个问题，是为了写出数独游戏的隐含数对法。这个是隐含数对法中的同行隐含数对法，即同一行有9个单元格，每个单元格的数字都是升序排列，且绝不重复。在同一行里，数字由1到9，如果其中有2个数字都出现2次，且每次都是一起出现在同一格里，即为所求数。之前已经用过字典、正则之类的。可惜数据一变，又变得不符合要求。现附件已上传个人自制的数独游戏，君可试玩，能更明显清楚是什么回事。除了隐含数对法部分功能受限制，其它均试验成功。该游戏只有唯一解，我已用暴力破解验算过了。

lingyuncelia1

JX_shangrila 发表于 2016-2-23 14:51
看了楼主的几个类似帖子，好像这个57不是指定的，而是根据a1:i1区域数据分析判断出来的。楼主需要解决的问题 ...

谢谢大侠的宝贵意见，其实提出这个问题，是为了写出数独游戏的隐含数对法。这个是隐含数对法中的同行隐含数对法，即同一行有9个单元格，每个单元格的数字都是升序排列，且绝不重复。在同一行里，数字由1到9，如果其中有2个数字都出现2次，且每次都是一起出现在同一格里，即为所求数。之前已经用过字典、正则之类的。可惜数据一变，又变得不符合要求。现附件已上传个人自制的数独游戏，君可试玩，能更明显清楚是什么回事。除了隐含数对法部分功能受限制，其它均试验成功。该游戏只有唯一解，我已用暴力破解验算过了。如果能在一个钟头内靠人脑解题，都可以挑战最强大脑了。

lingyuncelia1

grf1973 发表于 2016-2-23 14:09
经过测试，当第一个57查找出来并用a&b赋值后，mycount=1。应该是赋值后系统自动把a&b认为是数据型的了，在以 ...

参照你的方法，如果将代码修改如下是可以得到2个57的：
Sub c()
Sheet2.Range("A1:I9").FormulaR1C1 = "=TEXT(sheet1!RC,0)"
    Sheet2.Range("A1:I9").Copy
    Sheet1.Range("A1:I9").PasteSpecial Paste:=xlPasteValues
    Sheet2.Range("A1:I9").Clear
    Sheet1.Activate
a = 5
b = 7
mycount = Application.WorksheetFunction.CountIf(Range("a1:i1"), "*" & "5" & "*" & "7" & "*")
For k = 1 To 9
If mycount = 2 And Cells(1, k).Text Like "*" & "5" & "*" & "7" & "*" Then
Cells(1, k).Font.Size = 36
Cells(1, k) = "" & a & b
End If
  Next
End Sub
但如果变成如下代码，则只能保留第一个57.
Sub c()
Sheet2.Range("A1:I9").FormulaR1C1 = "=TEXT(sheet1!RC,0)"
    Sheet2.Range("A1:I9").Copy
    Sheet1.Range("A1:I9").PasteSpecial Paste:=xlPasteValues
    Sheet2.Range("A1:I9").Clear
    Sheet1.Activate
a = 5
b = 7
  For k = 1 To 9
mycount = Application.WorksheetFunction.CountIf(Range("a1:i1"), "*" & "5" & "*" & "7" & "*")
If mycount = 2 And Cells(1, k).Text Like "*" & "5" & "*" & "7" & "*" Then
Cells(1, k).Font.Size = 36
Cells(1, k) = "" & a & b
End If
  Next
End Sub

所以Cells(1, k) = "" & a & b不是关键，位置才是重点。

lingyuncelia1

lichuanboy44 发表于 2016-2-23 12:57
原代码错误的原因是将 "*" & a & "*" & "b" & "*")中的b加了双引号，
但即使你把数字通过复制后粘贴变 ...

谢谢，刚试过，果然是18啊

lingyuncelia1

JX_shangrila 发表于 2016-2-23 14:51
看了楼主的几个类似帖子，好像这个57不是指定的，而是根据a1:i1区域数据分析判断出来的。楼主需要解决的问题 ...

数字38与57都不算，因为第一行数字3已经出现5次了，而8出现了3次。
K1才集合了2次出现的数字，而其中的57才为我所求，因为它们每次都一起出现在同一单元格。
下列代码能达到我的查找保留要求，至于K1的数字我可以通过字典来集合：
Sub c()
Sheet2.Range("A1:I9").FormulaR1C1 = "=TEXT(sheet1!RC,0)"
    Sheet2.Range("A1:I9").Copy
    Sheet1.Range("A1:I9").PasteSpecial Paste:=xlPasteValues
    Sheet2.Range("A1:I9").Clear
    Sheet1.Activate
For i = 1 To Len(Cells(1, 11)) - 1
For j = i + 1 To Len(Cells(1, 11))
a = Mid(Cells(1, 11).Text, i, 1)
b = Mid(Cells(1, 11).Text, j, 1)
mycount = Application.WorksheetFunction.CountIf(Range("a1:i1"), "*" & a & "*" & b & "*")
  For k = 1 To 9
  If mycount = 2 And Cells(1, k).Text Like "*" & a & "*" & b & "*" Then Cells(1, k).Font.Size = 36: Cells(1, k) = a & b
  Next
Next
Next
End Sub