Excel中VBA如何操作两个表的数据

Excel中VBA如何操作两个表的数据

Public Sub 复制数据()
Dim sh1, sh2 As Range
Set sh1 = Sheets("biao1").Range("A1:A10000")
Set sh2 = Sheets("biao2").Range("D1:D10000")
Sheets("biao3").Range("a1") = Sheets("biao1").Range("A1")
han = 0
For x = 1 To 100
sj = Sheets("biao1").Cells(x, 1)
If han > 0 Then
For y = 1 To han
sj1 = Sheets("biao3").Cells(y, 1)
If sj1 = sj Then
cf = True
Exit For
Else
cf = False
End If
Next y
End If
If cf = False Then
han = han + 1
Sheets("biao3").Cells(han, 1) = Sheets("biao1").Cells(x, 1)
End If

Next x

han = han - 1

For x = 1 To 100
sj = Sheets("biao2").Cells(x, 1)

If han > 1 Then
For y = 1 To han
sj1 = Sheets("biao3").Cells(y, 1)
If sj1 = sj Then
cf = True
Exit For
Else
cf = False
End If
Next y
End If

If cf = False Then
han = han + 1
Sheets("biao3").Cells(han, 1) = Sheets("biao2").Cells(x, 1)
End If

Next x

End Sub

哈哈，学习了。UsedRange.Rows.Count：表中有数据的最后一行的行号。

Public Sub 复制数据() Dim sh1 As Object, sh2 As Object Set sh1 = Sheets("biao1") Set sh2 = Sheets("biao2") n = sh1.Range("A65536").End(3).Row m = sh1.Range("A65536").End(3).Row Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "biao3" Range("A1") = "biao1+biao2" sh1.Range("A1:A" & n).Copy Range("a2") sh2.Range("A1:A" & m).Copy Range("a" & n + 1) Range("A:A").AdvancedFilter Action:=xlFilterInPlace, Unique:=True End Sub

思路： 将表1表2当数据引入数组1中 用数组1中当每一个数和整个数组对比如果只有一次相同则将这个数存储在数组2中 将数组2全部写入表3中 dim a dim shuzu1() dim shuzu2() a=0 for each dangqian in sheets("biao1").[a:a] ReDim Preserve shuzu1(a+1) shuzu(a)= dangqian.value a=a+1 next for each dangqian in sheets("biao2").[a:a] ReDim Preserve shuzu1(a+1) shuzu(a)= dangqian.value a=a+1 next for b= 0 to a d=0 for c=0 to a if shuzu1(b)=shuzu1( c ) then d=d+1 end if next if d=1 then ReDim Preserve shuzu2(b+1) shuzu2(e)=shuzi1(b) e=e+1 end if next for f= 0 to e sheets("biao1").[a & e + 1] = shuzu2(e) next 注意：未测试，如有错误请自己解决。

方法一：用工作表函数countif判断该行是否重复 sub 删除重复行1() dim i as long application.screenupdating = false for i = range("a65536").end(xlup).row to 3 step -1 if worksheetfunction.countif(range("a2:a" & i), cells(i, 1)) > 1 then cells(i, 1).entirerow.delete end if next application.screenupdating = true end sub 方法二：先高级筛选，再删除隐藏行 sub 删除重复行2() dim rcell as range, rrng as range, drng as range on error resume next application.screenupdating = false set rrng = range("a1:a" & range("a65536").end(xlup).row) rrng.advancedfilter action:=xlfilterinplace, unique:=true for each rcell in rrng if rcell.entirerow.hidden = true then if drng is nothing then set drng = rcell.entirerow else set drng = application.union(drng, rcell.entirerow) end if end if next if not drng is nothing then drng.delete activesheet.showalldata application.screenupdating = true end sub