[已解决]请老师帮助用VBA弄下

excel白兔 · 发表于 2017-4-4 10:37

请老师帮助下，VBA做或公式做都可以。急在线等谢谢了

最佳答案

月排行榜 / 总排行榜

苏子龙

2017-4-4 19:55

Sub tt()
Dim arr1, arr2, d
Dim i%, str$
Set d = CreateObject("scripting.dictionary")
arr1 = Sheet1.UsedRange
arr2 = Sheet2.UsedRange
For i = 3 To UBound(arr2)
str = Application.Trim(arr2(i, 1))
If str <> "" Then d(str) = ""
Next
For i = 2 To UBound(arr1)
str = Application.Trim(arr1(i, 1))
If Not d.exists(str) Then
d.Add str, "无"
End If
Next
Sheet3.Range("a3").Resize(d.Count, 1) = Application.Transpose(d.Keys)
Sheet3.Range("b3").Resize(d.Count, 1) = Application.Transpose(d.items)
End Sub
大概怎样

复制代码

跳转到最佳答案楼层

excel白兔 · 发表于 2017-4-4 10:43

我说的有什么不明白的地方还请老师回复，我在线说明。谢谢
说的比较多，简单来说就是要做个总表表3，包含基础表2和基础表1。表1有的表2没有的在表3里显示家红色

excel白兔 · 发表于 2017-4-4 10:44

判定标准用的是10位代码，10位代码后面的不用加入判断。

wenzili · 发表于 2017-4-4 19:52

Public Sub master()
Dim vaSheet1data As Variant
Dim vaSheet2data As Variant
Dim lS1Dim1 As Long, lS1Dim2 As Long
Dim lS2Dim1 As Long, lS2Dim2 As Long
Dim iFinded As Integer
Dim i As Long
Dim rng As Range
i = 0
vaSheet1data = Sheet1.Range("a1").CurrentRegion
vaSheet2data = Sheet2.Range("a1").CurrentRegion
With Sheet3
.Range("a:a").Clear
.Range("a1").Resize(UBound(vaSheet2data, 1), UBound(vaSheet2data, 2)) = vaSheet2data
For lS1Dim1 = 1 To UBound(vaSheet1data, 1)
      iFinded = 0
      For lS2Dim1 = 1 To UBound(vaSheet2data, 1)
         If Left(vaSheet1data(lS1Dim1, 1), 12) Like Left(vaSheet2data(lS2Dim1, 1), 12) Then
               iFinded = 1
               Exit For
         End If
      Next
      If iFinded = 0 Then
      With .Range("a1048576").End(xlUp).Offset(i, 0)
         .Value = vaSheet1data(lS1Dim1, 1)
         .Interior.ColorIndex = 3
      End With
      i = i + 1
      End If
Next
End With
End Sub
但是表一的科目都在表二中？

苏子龙 · 发表于 2017-4-4 19:55

Sub tt()
Dim arr1, arr2, d
Dim i%, str$
Set d = CreateObject("scripting.dictionary")
arr1 = Sheet1.UsedRange
arr2 = Sheet2.UsedRange
For i = 3 To UBound(arr2)
str = Application.Trim(arr2(i, 1))
If str <> "" Then d(str) = ""
Next
For i = 2 To UBound(arr1)
str = Application.Trim(arr1(i, 1))
If Not d.exists(str) Then
d.Add str, "无"
End If
Next
Sheet3.Range("a3").Resize(d.Count, 1) = Application.Transpose(d.Keys)
Sheet3.Range("b3").Resize(d.Count, 1) = Application.Transpose(d.items)
End Sub
大概怎样

复制代码

excel白兔 · 发表于 2017-4-4 21:06

苏子龙发表于 2017-4-4 19:55

谢谢老师的帮助，我回家了，家里没有高版本的EXCEL，我的是2003版本的，老师能否帮我转换成2003的我在试试，因为很期待，很想现在就看看，我自己拿2003的自己又填写了点数据测试结果不对呀。

excel白兔 · 发表于 2017-4-4 21:07

wenzili 发表于 2017-4-4 19:52
Public Sub master()
Dim vaSheet1data As Variant
Dim vaSheet2data As Variant

老师好，我回家了，家里只有2003的excel ，我哪2003的测试了下，提示中断要调试，能否帮助我转换成2003的我下载在试试，谢谢老师呀

提示这个.Range("a1").Resize(UBound(vaSheet2data, 1), UBound(vaSheet2data, 2)) = vaSheet2data中断

wenzili · 发表于 2017-4-4 21:12

With .Range("a1048576").End(xlUp).Offset(i, 0)，
改为With .Range("a65536").End(xlUp).Offset(i, 0)，

试试

excel白兔 · 发表于 2017-4-4 21:34

wenzili 发表于 2017-4-4 21:12
With .Range("a1048576").End(xlUp).Offset(i, 0)，
改为With .Range("a65536").End(xlUp).Offset(i, 0)， ...

该完了老师不行，.Range("a1").Resize(UBound(vaSheet2data, 1), UBound(vaSheet2data, 2)) = vaSheet2data

这中断，提示类型不匹配

wenzili · 发表于 2017-4-4 21:55

excel白兔发表于 2017-4-4 21:34
该完了老师不行，.Range("a1").Resize(UBound(vaSheet2data, 1), UBound(vaSheet2data, 2)) = vaSheet2da ...

那就不知道了，我是2010，没有报错

		自动登录	找回密码
密码			注册