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

lingyuncelia1 · 发表于 2016-2-22 22:47

本帖最后由 lingyuncelia1 于 2016-2-23 20:08 编辑

Sub c()
Sheet2.Range("A1:I1").FormulaR1C1 = "=TEXT(sheet1!RC,0)"
Sheet2.Range("A1:I1").Copy
Sheet1.Range("A1:I1").PasteSpecial Paste:=xlPasteValues
Sheet2.Range("A1:I1").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
  Next

End Sub

为什么运行以上代码后，H1无法保留57，而C1却可以保留57？

最佳答案

月排行榜 / 总排行榜

grf1973

2016-2-23 16:00

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

Sub grf()
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")
arr = [a1].CurrentRegion
For i = 1 To UBound(arr)
For j = 1 To UBound(arr, 2)
x = arr(i, j)
If Len(x) >= 2 Then
For m = 1 To Len(x) - 1
For n = m + 1 To Len(x)
xkey = Mid(x, m, 1) & Mid(x, n, 1) '两位数的组合
d(xkey) = d(xkey) + 1 '不同两位数出现的次数
d1(xkey) = d1(xkey) & "," & Cells(i, j).Address '不同两位数所在的单元格地址
Next
Next
End If
Next
For Each xkey In d.keys
If d(xkey) = 2 Then
rg = Mid(d1(xkey), 2)
Range(rg).Font.Size = 36
Range(rg) = xkey
Exit For '最多只找一对
End If
Next
d.RemoveAll
d1.RemoveAll
Next
End Sub

复制代码

跳转到最佳答案楼层

lichuanboy44 · 发表于 2016-2-23 09:12

本帖最后由 lichuanboy44 于 2016-2-23 09:17 编辑

此问题好像已看过一次了，不知这样有可用
Sub 处理()
  a = 5
  b = 7
  For k = 1 To 9
'mycount = Application.WorksheetFunction.CountIf(Range("a1:i1"), "*" & "5" & "*" & "7" & "*") 原句多余，影响判定
   If Cells(1, k) Like "*" & "5" & "*" & "7" & "*" Then
      Cells(1, k) = a & b
      Cells(1, k).Font.Size = 36
   End If
  Next
End Sub

lingyuncelia1 · 发表于 2016-2-23 09:22

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

谢谢您的宝贵意见,但是我写的代码目的是:在一行数据里,数字1到9,如果某2个数字出现2次,且2次,每次都出现在同一单元格.
所以才写出if mycount=2.但很奇怪,如果没有代码:cells(1,k)=a & b,代码可以36号显示特定的单元格.但无法保留特定的数字.
后来写以下代码,根本36号都不显示.
Sub 隐含唯2数法()
'数字变文本
Sheet2.Range("A1:I1").FormulaR1C1 = "=TEXT(sheet1!RC,0)"
Sheet2.Range("A1:I1").Copy
Sheet1.Range("A1:I1").PasteSpecial Paste:=xlPasteValues
Sheet2.Range("A1:I1").Clear
Sheet1.Activate
Dim mycount As Integer, a As Integer, j As Integer
For j = 1 To 9
  For a = 1 To 8
  For b = a + 1 To 9
mycount = Application.WorksheetFunction.CountIf(Rows(1), "*" & a & "*" & "b" & "*")
If mycount = 2 And Cells(1, j).Value Like "*" & a & "*" & "b" & "*" Then
Cells(1, j).Font.Size = 36
Cells(1, j) = a & b
End If
  Next b
  Next a
Next j
End Sub

lichuanboy44 · 发表于 2016-2-23 11:09

本帖最后由 lichuanboy44 于 2016-2-23 11:11 编辑

如果57只出现2次，则标示为36号字体，在A1:I1出现1次或3次则不标示，如果是这个意思，代码如下：

Sub 处理()
a = 5
b = 7
s = "*" & a & "*" & b & "*"
Set myrng = Sheet1.Range("A1:I1")
Set c = myrng.Find(s)
If Not c Is Nothing Then
firstad = c.Address
Do
p = p + 1
Set c = myrng.FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstad
End If
If p = 2 Then
For k = 1 To 9
If Cells(1, k) Like s Then
Cells(1, k) = a & b
Cells(1, k).Font.Size = 36
End If
Next
End If
End Sub

复制代码

另外，不要盲目地硬用countif，你原来的程序语句mycount = Application.WorksheetFunction.CountIf(Rows(1), "*" & a & "*" & "b" & "*") 始终统计结果为0，原因为:"*" & a & "*" & "b" & "*",运算结果为"*5*7*"，这是一个文本字符，而工作表A1:I1中的值为数值，故明明看见有15678和357，但统计结果为0，故其后的If mycount = 2永远不符合条件。除非你将A1:I1设置成文本。

lingyuncelia1 · 发表于 2016-2-23 12:01

本帖最后由 lingyuncelia1 于 2016-2-23 12:02 编辑

lichuanboy44 发表于 2016-2-23 11:09
如果57只出现2次，则标示为36号字体，在A1:I1出现1次或3次则不标示，如果是这个意思，代码如下：另外， ...

谢谢您的宝贵意见,我的确是这个意思.如果变成如下代码是可以的:
Sub c()

Sheet2.Range("A1:I1").FormulaR1C1 = "=TEXT(sheet1!RC,0)"

Sheet2.Range("A1:I1").Copy

Sheet1.Range("A1:I1").PasteSpecial Paste:=xlPasteValues

Sheet2.Range("A1:I1").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 Sub

但我改写成以下代码又不成功了
Sub 隐含唯2数法()
'数字变文本
Sheet2.Range("A1:I1").FormulaR1C1 = "=TEXT(sheet1!RC,0)"
Sheet2.Range("A1:I1").Copy
Sheet1.Range("A1:I1").PasteSpecial Paste:=xlPasteValues
Sheet2.Range("A1:I1").Clear
Sheet1.Activate
  For j = 1 To 9
  For a = 1 To 8
  For b = a + 1 To 9
mycount = Application.WorksheetFunction.CountIf(Range("a1:i1"), "*" & a & "*" & "b" & "*")
next
next
   If mycount = 2 And Cells(1, j).Value Like "*" & a & "*" & "b" & "*" Then
Cells(1, j).Font.Size = 36
Cells(1, j) = a & b
end if
   Next
  End Sub
难道要用肉眼找数字5与7?

lichuanboy44 · 发表于 2016-2-23 12:57

本帖最后由 lichuanboy44 于 2016-2-23 13:07 编辑

lingyuncelia1 发表于 2016-2-23 12:01
谢谢您的宝贵意见,我的确是这个意思.如果变成如下代码是可以的:
Sub c()Sheet2.Range("A1:I1").Formul ...

原代码错误的原因是将 "*" & a & "*" & "b" & "*")中的b加了双引号，
但即使你把数字通过复制后粘贴变成了文本格式，但你程序语句有点乱，好像达不到效果
Sub 隐含唯2数法()
'数字变文本
Sheet2.Range("A1:I1").FormulaR1C1 = "=TEXT(sheet1!RC,0)"
Sheet2.Range("A1:I1").Copy
Sheet1.Range("A1:I1").PasteSpecial Paste:=xlPasteValues
Sheet2.Range("A1:I1").Clear
Sheet1.Activate
  For j = 1 To 9
  For a = 1 To 8
  For b = a + 1 To 9
mycount = Application.WorksheetFunction.CountIf(Range("a1:i1"), "*" & a & "*" & "b" & "*")
next
next
   If mycount = 2 And Cells(1, j).Value Like "*" & a & "*" & "b" & "*" Then
Cells(1, j).Font.Size = 36
Cells(1, j) = a & b
end if
   Next
  End Sub
   你以上语句的意思是， a从1到8，b从a+1到9进行组合，循环查找，但这样的组合依次为：11到19；23到29；34至39直至78到89。但没有21，31到91，以及32，42到92。所以还是没弄明白，你要查找什么样的数字组合。
   另外，以上程序，首先查找到两个18和两个28，C1的15678和另外一个F1的1238首先循环到因符合个数等于2，其变成了18，永远也变不成57了。

grf1973 · 发表于 2016-2-23 14:09

经过测试，当第一个57查找出来并用a&b赋值后，mycount=1。应该是赋值后系统自动把a&b认为是数据型的了，在以后的countif中找不出来。把判断语句改一下问题就解决了：
If mycount = 2 And Cells(1, k) Like x Then Cells(1, k).Font.Size = 36: Cells(1, k) = "'" & a & b

grf1973 · 发表于 2016-2-23 14:09

语句中的 x = "*" & a & "*" & b & "*"

grf1973 · 发表于 2016-2-23 14:11

请看附件。

JX_shangrila · 发表于 2016-2-23 14:51

看了楼主的几个类似帖子，好像这个57不是指定的，而是根据a1:i1区域数据分析判断出来的。楼主需要解决的问题好像是下面这样的，如果是这样的话，建议用递归算法。

1 数据区域是a1:i1，数据以行为分析依据，a1:i1为一组。
2 单元格中的数据按二个数字进行组合,不区分数字的前后位置，即12与21是重复数据，
如a1单元格数据组合后是:12、13、16、23、26、32、36。如果是全组合的，即12、13、
16、23、26、32、36、21、31、61、62、63需要把21、31、61、62、63删除。
3 需要筛选出在a1:i1单元格范围内，某个组合数据仅出现二次的数据，比如38和57

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

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

评分

评分

评分

评分

评分

评分

评分