Office中国论坛/Access中国论坛

标题: 求助复制难题 [打印本页]

作者: makou 时间: 2004-12-12 22:07
标题: 求助复制难题
请论坛高手出手相助,在此表示感谢!

问题见附件[attach]8101[/attach]

作者: 情比金坚 时间: 2004-12-12 23:29
一体化的方式想不到，

不过可以用countif()很容易的找出彼此不重复的数据，和重复两次以上的数据。

再用复制----选择性粘贴可以完成你的要求。

[此贴子已经被作者于2004-12-12 15:32:05编辑过]

作者: foxxp 时间: 2004-12-13 01:35
Sub test()

  Dim sh1 As Worksheet

  Dim sh2 As Worksheet

  Dim sht As Worksheet

  '计数器i表示sheet1的当前行

  Dim i As Integer

  '计数器j表示sheet3的当前行

  Dim j As Integer

  Dim f As Integer

  '从第二行开始，忽略标题

  i = 2

  Set sh1 = Worksheets("sheet1")

  Set sh2 = Worksheets("sheet2")

  Set sht = Worksheets("sheet3")

  '清空sheet3的内容

  sht.Cells.ClearContents

  '填写标题

  sht.Cells(1, 1) = sh1.Cells(1, 1)

  sht.Cells(1, 2) = sh1.Cells(1, 2)

  j = 2

  Do While True

   '遇到空行结束

   If sh1.Cells(i, 1) = "" Then

      Exit Do

   End If

   On Error Resume Next

   '假设找不到

   f = -1

   f = Application.WorksheetFunction.Match(sh1.Cells(i, 1), sh2.Range("a:a"), 0)

   '如果找不到,f不会被赋值,保持-1

   If f = -1 Then

      sht.Cells(j, 1) = sh1.Cells(i, 1)

      sht.Cells(j, 2) = sh1.Cells(i, 2)

      j = j + 1

   End If

   'If Application.WorksheetFunction.Match(sh1.Cells(i, 1), sh2.Range("a:a"), 0) > 0 Then

   'End If

   i = i + 1

  Loop

End Sub[attach]8105[/attach]

作者: 情比金坚 时间: 2004-12-13 03:39
那个重复了两次地“C”没有被找到呢

作者: makou 时间: 2004-12-13 03:42
谢谢版主和Foxxp，对我的帮助很大，如果有解决重复数据的方案一定告诉我一下，再次感谢！

作者: 老鬼 时间: 2004-12-13 05:01
Sub copyit()

Dim s1 As Worksheet

Dim s2 As Worksheet

Dim s3 As Worksheet

Dim x

Dim y

Dim i

Set s1 = Worksheets("sheet1")

Set s2 = Worksheets("sheet2")

Set s3 = Worksheets("sheet3")

x = s1.[a2].End(xlDown).Row

y = s2.[a2].End(xlDown).Row

For Each CEL2 In s1.Range("A2:A" & x) '求表1不在表2中的值

i = 0

      For Each CEL In s2.Range("A2:A" & y)

      If CEL2 = CEL Then

      i = i + 1

      End If

      Next

If i <> 1 Then

s3.[A65536].End(xlUp).Offset(1, 0).Value = CEL2.Value

s3.[A65536].End(xlUp).Offset(0, 1).Value = CEL2.Offset(0, 1).Value

End If

Next

For Each CEL2 In s2.Range("A2:A" & y) '求表1在表2中，但有重复的值

i = 0

      For Each CEL In s1.Range("A2:A" & x)

      If CEL2 = CEL Then

      i = i + 1

      End If

      Next

If i <> 1 Then

s3.[A65536].End(xlUp).Offset(1, 0).Value = CEL2.Value

s3.[A65536].End(xlUp).Offset(0, 1).Value = CEL2.Offset(0, 1).Value

End If

Next

End Sub

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)