以下是实现该功能的VBA代码：

Sub FindDuplicate()

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

Dim rng1 As Range, rng2 As Range

Dim ws As Worksheet

Set ws = ThisWorkbookSheets("Sheet1") '指定操作的工作表

For i = 5 To 20 Step 4 '循环遍历每4行数据

Set rng1 = wsRange("A" & i & ":O" & i) '获取当前行的数据范围

For j = i + 1 To i + 3 '循环遍历当前行的下一行到下三行

Set rng2 = wsRange("A" & j & ":O" & j) '获取下一行到下三行的数据范围

For k = 17 To 1 Step -1 '从O列开始往前遍历

If rng1Cells(1, k) = rng2Cells(1, k) Then '判断是否有重复数字

wsRange("Q" & i) = rng1Cells(1, k) '将重复数字放在Q:Z列

wsRange("R" & i) = rng1Cells(1, k)

wsRange("S" & i) = rng1Cells(1, k)

wsRange("T" & i) = rng1Cells(1, k)

wsRange("U" & i) = rng1Cells(1, k)

wsRange("V" & i) = rng1Cells(1, k)

wsRange("W" & i) = rng1Cells(1, k)

wsRange("X" & i) = rng1Cells(1, k)

wsRange("Y" & i) = rng1Cells(1, k)

wsRange("Z" & i) = rng1Cells(1, k)

Exit For '找到一个重复数字就退出循环

End If

Next k

Next j

Next i

'将结果在另一行输出

For i = 4 To 20 Step 4

Set rng1 = wsRange("Q" & i & ":Z" & i)

Set rng2 = wsRange("A" & i & ":O" & i)

For j = 1 To 10

If WorksheetFunctionCountIf(rng1, rng2Cells(1, j)) > 1 Then

wsCells(22, j) = rng2Cells(1, j)

End If

Next j

Next i

End Sub

这个代码首先使用循环遍历每四行数据，对于每一行，再使用循环遍历当前行的下一行到下三行，判断是否有重复数字。如果有重复数字，就将这些数字放在Q:Z列。最后，再遍历每四行数据的结果，统计出重复的数字，并将结果在第22行输出。

dim o,k,r,i

set o=createobject("scriptingdictionary")

for each r in range("a1:d10")cells

    k = rvalue

    o(k)=o(k)+1

next r

i=1

for each k in okeys

    cells(i,10)=k

    cells(i,11)=o(k)

    i=i+1

next k

前面的循环统计数据，后面的循环显示结果（I、J列）

Sub 行排序()

Range("D3:K4")Select '排序的区域 ,按第4行从大到小排序

SelectionSort Key1:=Range("D4"), Order1:=xlDescending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, SortMethod _

:=xlPinYin, DataOption1:=xlSortNormal

End Sub

一、在SHEET表内设置好按钮，并指定到宏。（宏所在SHEET的名称为“图表”）

二、在VBA编辑器内输入如下的代码。（此代码的含义为遍布区域内的单元格，如果为空格，则隐藏空格所在的整列。

三、在运行过程中出现了问题，下标越界，无法运行。

四、查看问题原因为，在代码中的“SHEET1”工作表根本没有，因为SHEET表的标签名称为“图表”，因此代码运行时找不到"SHEET1"工作表，所以提示下标越界。

五、点击异常提示下的“调试”按钮，将代码中“SHEET1”改为“图表”后再点按钮，运行宏，代码正常运行，无下表越界提示。

我可以为您提供有关使用 VBA 将表一的信息录入表二的指导如下：

使用 VBA 将表一的信息录入表二的基本方法如下所示：

1 打开 Excel，然后打开表一和表二。

2 在表二中创建与表一相同的列名。

3 启用 VBA 编辑器，为代码创建一个新的模块。

4 在代码模块中，使用“for”或“while”循环遍历表一所有行。

5 对于每个行，将特定数据复制到表二中创建的相应列中。

6 编写完成后，执行 VBA 代码即可将表一的信息录入表二。

这里提供一段 VBA 代码供您参考：

Sub copyDataToTable2()

Dim x As Long

Dim lastRow As Long

lastRow = Sheets("表一")Range("A" & RowsCount)End(xlUp)Row

For x = 2 To lastRow

Sheets("表二")Cells(x, 1) = Sheets("表一")Cells(x, 1)

Sheets("表二")Cells(x, 2) = Sheets("表一")Cells(x, 2)

'依次将表一中的所有数据复制到表二中创建的相应列中

Next x

End Sub

这段代码可以将表一的第一列和第二列数据复制到表二中，您可以根据需要修改。

希望以上指导可以帮到您。

找开excel的VBA，如果是2010版，按“Alt"+F11调出VBA，点中你写好的project, 再点文件-->导出文件，就可以保存你的VBA代码，如果其他表格也要用，点导入VBA就可以了。

用VBA程式设计如何遍历EXCEL每一个工作表 这段小程式就把一个EXCEL档案中每个工作表的A1单元格填上了a

Sub tt()

For i = 1 To ActiveWorkbookWorksheetsCount

ActiveWorkbookWorksheets(i)Cells(1, 1)Value = "a"

Next

End Sub

用VBA程式设计如何连线EXCEL每一个工作表

Private Sub CommandButton1_Click()

Dim ws As Worksheet

For Each ws In Worksheets

MsgBox (wsName)

Next

End Sub

EXCEL VBA 如何遍历工作表

Sub test()

For Each c In ActiveSheetComments

cParentInteriorColorIndex = 3

Next

End Sub

vba程式设计如何遍历每一个选择的单元格？

Sub sdk()

i = 1

For Each sc In Selection

scValue = i

i = i + 1

Next

End Sub

vb用ado如何遍历excel中所有工作表

1、用VB　开启EXCEL　档案　

2、遍历sheets和cells

Dim xlApp As ExcelApplication

Dim xlbook As ExcelWorkbook

Dim xlsheet As ExcelWorksheet

Private Sub Command1_Click()

Set xlApp = New ExcelApplication

xlAppVisible = True

Set xlbook = xlAppWorkbooksOpen("d:\hao\1xls")

For i = 1 To xlbookWorksheetsCount

Set xlsheet = xlbookWorksheets(i)

aa=xlsheetCells(1, 1)

Next

End Sub

EXCEL表格里有三个工作表，如何提取每一个表第一行到另一个工作表里

一次完成行吗？

在最末的工作表的A1输入

=INDIRECT("Sheet"&ROW()&"!"&CHAR(64+COLUMN())&1)

回车并向下填充至An（看你的工作表有多少）；

再选A1～An，一起向右填充。

excel表里怎样可以查到每一个工作表

首先按CTRL+F弹出“查询和替换”视窗，然后点窗口里的“选项”，将“范围”一项选为“工作簿”，这样就能在全部工作表中进行查找了。

VBA:如何遍历资料夹下面所有工作簿，然后每个工作簿新增一个新工作表

使用dir可以编列资料夹，一般结构是：

path="d:\xls\"filename=dir(path & "xls")while filename<>"" set wb=workbooksopen(path & filename) wbsheetsadd wbsave wbclose filename=dirwend

如何把一个excel工作表分成两个工作表