[已解决]各位大神求代码，帮帮我

柠檬infinite

各位大神求代码，要把Excel1 这个专利与相应的分类号对应，做成Excel2 这样的，有相应专利分类号的标为1，没有的标2

最佳答案

月排行榜 / 总排行榜

0126

2017-5-20 22:59

以下程序无法跨工作浦查找返回结果，仅供参考
Sub 查找()
Dim x, y, i, t, a, b, c, d
x = Sheets(1).Cells(65535, 1).End(xlUp).Row                 '第一个工作表a有几行
i = Sheets(2).Cells(65535, 1).End(xlUp).Row                 '第二个工作表a有几行
For a = 2 To x
  For b = 1 To i
   If Sheets(1).Cells(a, 1) = Sheets(2).Cells(b, 1) Then     '判断行重复
    y = Sheets(1).Cells(1, 250).End(xlToLeft).Column          '第一个工作表a1有几列
    t = Sheets(2).Cells(b, 250).End(xlToLeft).Column
    For c = 2 To y
     For d = 1 To t
      If Sheets(1).Cells(1, c) = Sheets(2).Cells(b, d) Then   '判断列重复
       Sheets(1).Cells(a, c) = 1                              '有=1
       Exit For                                               '结束运行for d
      Else
       Sheets(1).Cells(a, c) = 2                              '无=2
      End If
     Next
    Next
   End If
  Next
Next
End Sub

跳转到最佳答案楼层

柠檬infinite

文件在这里，新手忘了上传附件

0126

以下程序无法跨工作浦查找返回结果，仅供参考
Sub 查找()
Dim x, y, i, t, a, b, c, d
x = Sheets(1).Cells(65535, 1).End(xlUp).Row                 '第一个工作表a有几行
i = Sheets(2).Cells(65535, 1).End(xlUp).Row                 '第二个工作表a有几行
For a = 2 To x
  For b = 1 To i
   If Sheets(1).Cells(a, 1) = Sheets(2).Cells(b, 1) Then     '判断行重复
    y = Sheets(1).Cells(1, 250).End(xlToLeft).Column          '第一个工作表a1有几列
    t = Sheets(2).Cells(b, 250).End(xlToLeft).Column
    For c = 2 To y
     For d = 1 To t
      If Sheets(1).Cells(1, c) = Sheets(2).Cells(b, d) Then   '判断列重复
       Sheets(1).Cells(a, c) = 1                              '有=1
       Exit For                                               '结束运行for d
      Else
       Sheets(1).Cells(a, c) = 2                              '无=2
      End If
     Next
    Next
   End If
  Next
Next
End Sub

柠檬infinite

0126 发表于 2017-5-20 22:59
以下程序无法跨工作浦查找返回结果，仅供参考
Sub 查找()
Dim x, y, i, t, a, b, c, d

这几天没有上论坛，才看到，非常感谢您的帮助，我回去试一试，太谢谢您了

0126

柠檬infinite 发表于 2017-5-23 17:21
这几天没有上论坛，才看到，非常感谢您的帮助，我回去试一试，太谢谢您了

这几天学习了一下后改了一下代码使它可以跨工作蒲查询，
还在1号工作蒲里面加入了一个窗体，窗体查询的话不限制查询条件在哪行那列，可以修改返回结果


Dim x, y, i, t, a, b, c, d, c1 As Worksheet, c2 As Workbook
Set c1 = ActiveSheet                                 '当前工作表
Set c2 = ThisWorkbook                                '代码所在工作蒲
x = c1.Cells(65535, 1).End(xlUp).Row                 '第一个工作表a有几行
i = c2.Sheets(1).Cells(65535, 1).End(xlUp).Row                 '第二个工作表a有几行
For a = 2 To x
  For b = 1 To i
   If c1.Cells(a, 1) = c2.Sheets(1).Cells(b, 1) Then     '判断行重复
    y = c1.Cells(1, 250).End(xlToLeft).Column          '第一个工作表a1有几列
    t = c2.Sheets(1).Cells(b, 250).End(xlToLeft).Column
    For c = 2 To y
     if cells（1,c)="" then
      Exit For  
     End If
    For d = 1 To t
      If c1.Cells(1, c) = c2.Sheets(1).Cells(b, d) Then   '判断列重复
       c1.Cells(a, c) = 1                              '有=1
       Exit For                                               '结束运行for d
      Else
       c1.Cells(a, c) = 2                              '无=2
      End If
     Next
    Next
   End If
  Next
Next
End Sub

柠檬infinite

0126 发表于 2017-5-24 21:05
这几天学习了一下后改了一下代码使它可以跨工作蒲查询，
还在1号工作蒲里面加入了一个窗体，窗体查询的 ...

好的，我试一试，其实上回那个代码已经帮我解决大问题了，太谢谢您了，还帮我继续解决问题，非常感谢