[已解决]求助在AR2:AR中提取1 to 50中剩余的其他数字

ruhong18

假设P2:P中有1 to 50个不重复的数字，当P2:P中出现其中的某些数字的时候，在AR2:AR中提取（50个数字）剩下的不重复的其他数字，并依次升序排列；

最佳答案

月排行榜 / 总排行榜

风林火山

2022-8-29 15:37

ruhong18 发表于 2022-8-29 15:08
你好，当N列和O列有内容时，为何修改P列，显示的数据不是正确的数据呢？

修改这句代码：arr = Range("p2").CurrentRegion 改为：

arr=Range ("p2:p" & Cells(Rows.Count, 16).End(3).Row)

跳转到最佳答案楼层

hasyh2008

Sub tt()
    Dim ar, r%, d, k%
    Set d = CreateObject("scripting.dictionary")
    ar = [p2].CurrentRegion
    For r = 1 To UBound(ar)
        d(ar(r, 1)) = ""
    Next r
    k = 1
    For r = 1 To 50
        If Not d.exists(r) Then
            k = k + 1
            Cells(k, "ar") = r
        End If
    Next r
End Sub

风林火山

1. Sub test1()
   
2.     Dim arr, d, k As Integer
   
3.     arr = Range("p2").CurrentRegion
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     For k = 1 To 50
   
6.         d(k) = k
   
7.     Next k
   
8.     For k = 1 To UBound(arr)
   
9.         If d.exists(arr(k, 1)) Then d.Remove arr(k, 1)
   
10.     Next k
    
11.     Range("AR2").Resize(d.Count, 1) = Application.WorksheetFunction.Transpose(d.keys)
    
12. End Sub
    

复制代码

ruhong18

风林火山 发表于 2022-8-29 13:22

你好，当N列和O列有内容时，为何修改P列，显示的数据不是正确的数据呢？

		2																												1
55	55	4																												2
55	55	6																												3
55	55	8																												4
55	55	10																												5
55	55	12																												6
55	55	15																												7
55	55	18																												8
55	55	30																												9
55	55	21																												10
55	55	24																												11
55	55	26																												12
55	55	48																												13
55	55	31																												14
55	55	34																												15
		49																												16
																														17
																														18
																														19
																														20
																														21
																														22
																														23
																														24
																														25
																														26
																														27
																														28
																														29
																														30
																														31
																														32
																														33
																														34
																														35
																														36
																														37
																														38
																														39
																														40
																														41
																														42
																														43
																														44
																														45
																														46
																														47
																														48
																														49

ruhong18

hasyh2008 发表于 2022-8-29 12:17
Sub tt()
    Dim ar, r%, d, k%
    Set d = CreateObject("scripting.dictionary")

你好，当N列和O列有内容时，为何修改P列，显示的数据不是正确的数据呢？

风林火山

ruhong18 发表于 2022-8-29 15:08
你好，当N列和O列有内容时，为何修改P列，显示的数据不是正确的数据呢？

修改这句代码：arr = Range("p2").CurrentRegion 改为：

arr=Range ("p2:p" & Cells(Rows.Count, 16).End(3).Row)

rlz680926

Sub test()
Dim i As Integer, j, n
Dim arr
Dim brr(1 To 50, 1 To 1)
Dim d As Object
Set d = CreateObject("scripting.dictionary")
arr = Range("p2", Range("p65536").End(xlUp))
For i = 1 To UBound(arr)
    If Not d.exists(arr(i, 1)) Then
        d(arr(i, 1)) = i
    End If
Next

For j = 1 To arr(UBound(arr, 1), 1)
    If Not d.exists(j) Then
        n = n + 1
        brr(n, 1) = j
    End If
Next
[as2].Resize(n, 1) = brr
End Sub

ruhong18

风林火山 发表于 2022-8-29 15:37
修改这句代码：arr = Range("p2").CurrentRegion 改为：

arr=Range ("p2:p" & Cells(Rows.Count, 16). ...

感谢版主相助，因积分不够，无法打分，不好意思！

ruhong18

rlz680926 发表于 2022-8-29 17:06
Sub test()
Dim i As Integer, j, n
Dim arr

感谢帮助，测试完全正确，因积分不够，无法打分，不好意思！