Option Explicit
Dim X(1 To 1000) As Long
Private Sub Command1_Click()
MAKERAND
Dim i As Integer, j As Integer, K As Long, result() As String
For i = 1 To 999
For j = i + 1 To 1000
If ISFIT(X(i), X(j)) Then
K = K + 1
ReDim Preserve result(1 To K) '用于输出
result(K) = "X(" & i & ")=" & X(i) & "[" & dectoBin(X(i)) & "]" & vbCrLf & vbCrLf & "X(" & j & ")=" & X(j) & "[" & dectoBin(X(j)) & "]"
End If
Next
Next
MsgBox result(Int(Rnd * K + 1)), vbOKOnly, "共有" & K & "对满足条件!" '显示满足条件的个数,并随机显示满足条件的一对用于检验
End Sub
Sub MAKERAND()
Dim i As Long
For i = 1 To 1000
Randomize
X(i) = Int(Rnd * 2 ^ 10) '随机产生100个2 ^ 10以内的整数
Next
End Sub
Function ISFIT(ByVal A As Long, ByVal B As Long) As Boolean
Dim TEMP As String
TEMP = dectoBin(A Xor B) '异或,按位比较
ISFIT = (Len(TEMP) - Len(Replace(TEMP, "1", "")) <= 2) '1 的个数大于2说明至少2位以上不同
End Function
Function dectoBin(X As Long) As String
Const Bins = "0000000100100011010001010110011110001001101010111100110111101111"
Dim i As Integer, s As String, y As String
y = Hex(X)
s = ""
For i = 1 To Len(y)
s = s + Mid(Bins, (Val("&h" + Mid(y, i, 1)) * 4 + 1), 4) '经十六进制转换为二进制
Next
dectoBin = Format(s, "0")
End Function
Option Explicit
Dim X(1 To 1000) As Long
Private Sub Command1_Click()
MAKERAND
Dim i As Integer, j As Integer, K As Long, result() As String
For i = 1 To 999
For j = i + 1 To 1000
If ISFIT(i, j) Then
K = K + 1
ReDim Preserve result(1 To K) '用于输出
result(K) = "X(" & i & ")=" & X(i) & "[" & dectoBin(X(i)) & "]" & vbCrLf & vbCrLf & "X(" & j & ")=" & X(j) & "[" & dectoBin(X(j)) & "]"
End If
Next
Next
MsgBox result(Int(Rnd * K + 1)), vbOKOnly, "共有" & K & "对满足条件!" '显示满足条件的个数,并随机显示满足条件的一对用于检验
End Sub
Sub MAKERAND()
Dim i As Long
For i = 1 To 1000
Randomize
X(i) = Int(Rnd * 2 ^ 10) '随机产生100个2 ^ 10以内的整数
Next
End Sub
Function ISFIT(ByVal A As Long, ByVal B As Long) As Boolean
Dim TEMP As String
TEMP = dectoBin(A Xor B) '异或,按位比较
ISFIT = (Len(TEMP) - Len(Replace(TEMP, "1", "")) <= 2) '1 的个数大于2说明至少2位以上不同
End Function
Function dectoBin(X As Long) As String
Const Bins = "0000000100100011010001010110011110001001101010111100110111101111"
Dim i As Integer, s As String, y As String
y = Hex(X)
s = ""
For i = 1 To Len(y)
s = s + Mid(Bins, (Val("&h" + Mid(y, i, 1)) * 4 + 1), 4) '经十六进制转换为二进制
Next
dectoBin = Format(s, "0")
End Function
Option Explicit
Dim X(1 To 1000) As Long
Private Sub Command1_Click()
MAKERAND
Dim i As Integer, J As Integer, K As Long, result() As String
For i = 1 To 999
For J = i + 1 To 1000
If ISFIT(i, J) Then
K = K + 1
ReDim Preserve result(1 To K)
result(K) = "X(" & i & ")=" & X(i) & "[" & dectoBin(X(i)) & "]" & vbCrLf & vbCrLf & "X(" & J & ")=" & X(J) & "[" & dectoBin(X(J)) & "]"
End If
Next
Next
MsgBox result(Int(Rnd * K + 1)), vbOKOnly, "共有" & K & "对满足条件!"
End Sub
Sub MAKERAND()
Dim i As Long
For i = 1 To 1000
Randomize
X(i) = Int(Rnd * 2 ^ 10)
Next
End Sub
Function ISFIT(ByVal A As Long, ByVal B As Long) As Boolean
ISFIT = True
If Abs(Len(dectoBin(A)) - Len(dectoBin(B))) > 2 Then
ISFIT = False
Exit Function
Else
Dim TEMP As Long, r As Integer
r = 0
TEMP = A And B
Do While TEMP
r = r + 1
TEMP = TEMP And (TEMP - 1)
If r > 2 Then
ISFIT = False
Exit Do
End If
Loop
End If
End Function
Function dectoBin(X As Long) As String
Const Bins = "0000000100100011010001010110011110001001101010111100110111101111"
Dim i As Integer, s As String, y As String
y = Hex(X)
s = ""
For i = 1 To Len(y)
s = s + Mid(Bins, (Val("&h" + Mid(y, i, 1)) * 4 + 1), 4)
Next
dectoBin = Format(s, "0")
End Function