获取列中不包含的数字

chxw68

cqz1314 发表于 2019-10-19 10:41
arr = .Range("a2:c" & r)

只支持前两列

你最好把文件发上来。

cqz1314

chxw68 发表于 2019-10-19 11:13
你最好把文件发上来。

分类2.rar (16.31 KB, 下载次数: 2)

2019-10-19 11:46 上传

点击文件名下载附件

辛苦了
我输入了一组新数据

在提取没完成学号是 没有完成提取出来

有的完成了  在没完成的表中也有   
谢谢

chxw68

修改好了。

cqz1314

chxw68 发表于 2019-10-19 12:30
修改好了。

谢谢

老师 我想让前4列生效 修改了这里  但是没有成功  
还需要改什么地方
能否在运行代码时 让【未完成】表中第1行，与【完成】表中第1行同名对应
拜托

cqz1314

cqz1314 发表于 2019-10-19 15:14
谢谢

老师 我想让前4列生效 修改了这里  但是没有成功  

求老师 帮忙点 一下 谢谢

YZC51

cqz1314 发表于 2019-10-20 13:27
求老师 帮忙点 一下 谢谢

请参考
  Dim r%, i%
  Dim arr, brr
  Dim d(1 To 4) As Object
  For i = 1 To 4
    Set d(i) = CreateObject("scripting.dictionary")
  Next
  With Worksheets("完成")
  r1 = .Cells(.Rows.Count, 1).End(xlUp).Row
  r2 = .Cells(.Rows.Count, 2).End(xlUp).Row
  r3 = .Cells(.Rows.Count, 3).End(xlUp).Row
  r4 = .Cells(.Rows.Count, 4).End(xlUp).Row
  
    r = Application.Max(r1, r2, r3, r4)
    arr = .Range("a2:d" & r)
    For j = 1 To 4
      For i = 1 To UBound(arr)
        d(j)(arr(i, j)) = ""
      Next
    Next
  End With
  With Worksheets("花名册")
    r = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("a2:b" & r)
    ReDim brr(1 To UBound(arr), 1 To 4)
    For j = 1 To 4
      m = 0
      For i = 1 To UBound(arr)
        If Not d(j).exists(arr(i, 1)) Then
          m = m + 1
          brr(m, j) = arr(i, 1)
        End If
      Next
    Next
  End With
  With Worksheets("没完成")
'    .UsedRange.Offset(1, 0).ClearContents
    .Range("a2").Resize(UBound(brr), UBound(brr, 2)) = ""
    .Range("a2").Resize(UBound(brr), UBound(brr, 2)) = brr
  End With
End Sub

YZC51

在审核...
  Dim r%, i%
  Dim arr, brr
  Dim d(1 To 4) As Object
  For i = 1 To 4
    Set d(i) = CreateObject("scripting.dictionary")
  Next
  With Sheet1
  r1 = .Cells(.Rows.Count, 1).End(xlUp).Row
  r2 = .Cells(.Rows.Count, 2).End(xlUp).Row
  r3 = .Cells(.Rows.Count, 3).End(xlUp).Row
  r4 = .Cells(.Rows.Count, 4).End(xlUp).Row
  
    r = Application.Max(r1, r2, r3, r4)
    arr = .Range("a2:d" & r)
    For j = 1 To 4
      For i = 1 To UBound(arr)
        d(j)(arr(i, j)) = ""
      Next
    Next
  End With
  With Sheet3
    r = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("a2:b" & r)
    ReDim brr(1 To UBound(arr), 1 To 4)
    For j = 1 To 4
      m = 0
      For i = 1 To UBound(arr)
        If Not d(j).exists(arr(i, 1)) Then
          m = m + 1
          brr(m, j) = arr(i, 1)
        End If
      Next
    Next
  End With
  With Sheet2
'    .UsedRange.Offset(1, 0).ClearContents
    .Range("a2").Resize(UBound(brr), UBound(brr, 2)) = ""
    .Range("a2").Resize(UBound(brr), UBound(brr, 2)) = brr
  End With
End Sub

YZC51

优化下
Sub test()
  Dim r%, i%
  Dim arr, brr
  Dim d(1 To 4) As Object
  For i = 1 To 4
    Set d(i) = CreateObject("scripting.dictionary")
  Next
  With Sheet1
    ar = .Range("a2:d1"): Sheet2.Range("a2:d1") = ar
    r5 = .UsedRange.Rows.Count
    arr = .Range("a2:d" & r5)
    For j = 1 To 4
      For i = 1 To UBound(arr)
        d(j)(arr(i, j)) = ""
      Next
    Next
  End With
  With Sheet3
    r = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("a2:b" & r)
    ReDim brr(1 To UBound(arr), 1 To 4)
    For j = 1 To 4
      m = 0
      For i = 1 To UBound(arr)
        If Not d(j).exists(arr(i, 1)) Then
          m = m + 1
          brr(m, j) = arr(i, 1)
        End If
      Next
    Next
  End With
  With Sheet2
'    .UsedRange.Offset(1, 0).ClearContents
    .Range("a2").Resize(UBound(brr) + 10, UBound(brr, 2)) = ""
    .Range("a2").Resize(UBound(brr), UBound(brr, 2)) = brr
  End With
End Sub

cqz1314

YZC51 发表于 2019-10-20 14:05
优化下
Sub test()
  Dim r%, i%

分类 修改.rar (13.45 KB, 下载次数: 2)

2019-10-20 21:26 上传

点击文件名下载附件

老师，谢谢您，辛苦了

麻烦您能不能帮我做如下调整：

当【完成】表中有记录时，运行代码，在【未完成】表中对应的列出未完人员，
【完成】表中是空列，则【未完成】表中为空，
无论【完成】表中有多少列记录，都生效，


万分感谢

YZC51

cqz1314 发表于 2019-10-20 21:29
老师，谢谢您，辛苦了

麻烦您能不能帮我做如下调整：

请参考
Sub test()
  Dim r%, i%
  Dim arr, brr
  Dim d(1 To 5) As Object
  If Sheet1.[a1] = "" Then Exit Sub
  For i = 1 To 5
    Set d(i) = CreateObject("scripting.dictionary")
  Next
  With Sheet1
    ar = .Range("a2:d1"): Sheet2.Range("a2:d1") = ar
    arr = .[a1].CurrentRegion.Value
    col = UBound(arr, 2)
    For j = 1 To UBound(arr, 2)
      For i = 1 To UBound(arr)
        d(j)(arr(i, j)) = ""
      Next
    Next
  End With
  With Sheet3
    r = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("a2:b" & r)
    ReDim brr(1 To UBound(arr), 1 To 5)
    For j = 1 To col
      m = 0
      For i = 1 To UBound(arr)
        If Not d(j).exists(arr(i, 1)) Then
          m = m + 1
          brr(m, j) = arr(i, 2)
        End If
      Next
    Next
  End With
  With Sheet2
'    .UsedRange.Offset(1, 0).ClearContents
    .Range("a2").Resize(UBound(brr) + 100, UBound(brr, 2) + 6) = ""
    .Range("a2").Resize(UBound(brr), UBound(brr, 2)) = brr
  End With
End Sub