请教excel中数据关联的宏代码

Dim bott, i, j, m, n, b As Integer
Dim s1, s2, ss1, ss2, ss As String
s1 = "sheet1"
s2 = "sheet2"盯兆
bott = Sheet1.Range("b65536").End(xlUp).Row
If bott < 28 Then
MsgBox "B列数据不充分"
GoTo ex1
End If
For i = 1 To 19
s1 = "sheet" & i
s2 = "sheet" & (i + 1)
For j = i + 7 To bott - 1
ss = ""
b = --Mid(Sheets(s1).Cells(j, 2), 1, 1)
ss2 = Sheets(s1).Cells(j + 1, 2)
For m = 1 To 5
ss = ss & ((b + Mid(ss2, m, 1)) Mod 10)
Next
Sheets(s2).Cells(j + 1, 2).NumberFormat = "@"
Sheets(s2).Cells(j + 1, 2) = ss
Next
Next
ex1:
End Sub

Sub jian()
Dim bott, i, j, m, n, b As Integer
Dim s1, s2, ss1, ss2, ss As String
s1 = "sheet1"
s2 = "sheet2"
bott = Sheet1.Range("b65536").End(xlUp).Row
If bott < 28 Then
MsgBox "B列数据不充分掘则慧"
GoTo ex1
End If
For i = 1 To 19
s1 = "sheet" & i
s2 = "sheet" & (i + 1)
For j = i + 7 To bott - 1
ss = ""判答
b = --Mid(Sheets(s1).Cells(j, 2), 1, 1)
ss2 = Sheets(s1).Cells(j + 1, 2)
For m = 1 To 5
ss = ss & ((b + 10 - Mid(ss2, m, 1)) Mod 10)
Next
Sheets(s2).Cells(j + 1, 2).NumberFormat = "@"
Sheets(s2).Cells(j + 1, 2) = ss
Next
Next
ex1:
End Sub

一下，我需要详细了解一下您数据的是什么样的等细节.

回答者： lxlzmh2002 - 魔导师 十一级 2009-9-11 21:48
===============================================================
代码如下:

Dim i As Long
Dim j As Long
Dim k As Long

Dim c As Integer

Dim irs As Long
Dim jrs As Long
Dim xt As Long
Dim zs As Long

Application.ScreenUpdating = False

Sheets("sheet6").Select
Range("A2:T65536").ClearContents

c = 1
For i = 1 To 4
For j = i + 1 To 5
irs = Sheets(i).Range("C65536").End(xlUp).Row
jrs = Sheets(j).Range("C65536").End(xlUp).Row
Cells(4, c) = Sheets(i).Name
Cells(4, c + 1) = Sheets(j).Name
Sheets(i).Range(Cells(2, 3).Address, Cells(irs, 3).Address).Copy Cells(5, c)
Sheets(j).Range(Cells(2, 3).Address, Cells(jrs, 3).Address).Copy Cells(5, c + 1)
c = c + 2
Next
Next

For k = 1 To c - 2 Step 2
irs = Cells(65536, k).End(xlUp).Row
jrs = Cells(65536, k + 1).End(xlUp).Row
Range(Cells(5, k + 1), Cells(jrs, k + 1)).Copy Cells(irs + 1, k)

irs1 = Cells(65536, k).End(xlUp).Row
zs = Range(Cells(5, k), Cells(irs1, k)).Count
xt = 0
For i = 5 To irs1 - 1
For j = i + 1 To irs1
If Cells(i, k) = Cells(j, k) Then
xt = xt + 1
End If
Next
Next
Cells(2, k) = "数据:" & zs
Cells(3, k) = "不同:" & zs - xt
Range(Cells(irs + 1, k), Cells(irs1, k)).ClearContents
Next

Application.ScreenUpdating = True

=================================================================
上述代码使用方法如下败键颤:

1. 选插一个空白表, 命名为: sheet6

2. 录制宏: "工具"菜单-->宏-->录制宏)--> 窗口上"快捷键(K)"下面Ctrl的右侧格内输入一个字母(作为快捷键)-->确定-->开始录制宏。

3. 编辑宏: 开始录制后即可直接按"停止"停止录制, 然后"工具"菜单-->宏亮洞-->宏(M)-->选择刚建那个宏-->点右边"编辑"按钮-->进入宏编辑界面-->删除Sub XXX 至 End Sub之间察败内容-->然后将上述VBA代码复制并粘贴到 Sub XXX 至 End Sub之间-->按工具栏上的"保存"按钮-->"文件"菜单-->关闭并反回MicorSoft Excel

4. 执行宏: 用快捷键(按住Ctrl不放, 再按那个录制宏时输入的字母)执行宏。也可以通过菜单"工具"-->宏-->宏(M)-->窗口上选宏名, 按"执行"按钮执行宏。