用vba求相差为1的数字，无法输出最后一行的数字。

icxh

如题。
想将所有行的数字加1、减1，并且按大小输出到下一行的指定位置，代码基本能执行，但是最后一行的结果始终无法输出。
详见附件。
还请大神指教。

代码如下

1. Sub GenerateAdjacentNumbers()
   
2.     Dim ws As Worksheet
   
3.     Set ws = ThisWorkbook.Sheets("sheet1")
   
4.    
   
5.     Dim lastRow As Long
   
6.     lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
   
7.    
   
8.     Dim i As Long, j As Long, k As Long
   
9.     Dim prevNum As Integer, nextNum As Integer
   
10.     Dim dict As Object
    
11.     Dim arr() As Integer
    
12.     Dim outputCol As Integer
    
13.    
    
14.     For i = 4 To lastRow
    
15.         Set dict = CreateObject("Scripting.Dictionary")
    
16.         
    
17.         ' 处理前一行的8个号码
    
18.         For j = 2 To 9
    
19.             Dim currentNum As Integer
    
20.             currentNum = ws.Cells(i - 1, j).Value
    
21.             
    
22.             ' 计算前一个数字
    
23.             prevNum = currentNum - 1
    
24.              If nextNum = 0 Then nextNum = 50
    
25.             dict(nextNum) = 1
    
26.             
    
27.             ' 计算后一个数字
    
28.             nextNum = currentNum + 1
    
29.              If nextNum = 51 Then nextNum = 1
    
30.             dict(nextNum) = 1
    
31.    
    
32.         Next j
    
33.         
    
34.         ' 转换并排序数组
    
35.         ReDim arr(dict.Count - 1)
    
36.         k = 0
    
37.         For Each Key In dict.Keys
    
38.             arr(k) = Key
    
39.             k = k + 1
    
40.         Next
    
41.         
    
42.         ' 使用冒泡排序
    
43.         For m = LBound(arr) To UBound(arr) - 1
    
44.             For n = m + 1 To UBound(arr)
    
45.                 If arr(m) > arr(n) Then
    
46.                     temp = arr(m)
    
47.                     arr(m) = arr(n)
    
48.                     arr(n) = temp
    
49.                 End If
    
50.             Next n
    
51.         Next m
    
52.         
    
53.         ' 输出结果到k列（第11列）
    
54.         outputCol = 11
    
55.         For m = 0 To UBound(arr)
    
56.             ws.Cells(i, outputCol + m).Value = arr(m)
    
57.         Next m
    
58.     Next i
    
59.    
    
60.     MsgBox "处理完成！"
    
61. End Sub
    

复制代码

上传1.zip (168.17 KB, 下载次数: 13)

2025-3-14 13:50 上传

点击文件名下载附件

ykcbf1100

既然是AI写的，继续让AI修改代码啊，直到有满意结果。

ynzsvt

看不懂你要干啥，好像是小鱼钓大鱼。

gwjkkkkk

最后S列数据怎么来的，没看懂？

ynzsvt

猜的。。。

chxw68

没看懂，但把楼主代码修改好了。

yynrzwh

Sub test()

ct = Cells(Rows.Count, 1).End(3).Row - 2

ar = Range("b3").Resize(ct, 8)
For i = 1 To ct
    For j = 1 To 8
        ar(i, j) = ar(i, j) + 1
    Next
Next

Range("k4").Resize(ct, UBound(ar, 2)) = ar
End Sub

icxh

ynzsvt 发表于 2025-3-14 20:47
猜的。。。

非常感谢！！！！

icxh

chxw68 发表于 2025-3-14 21:10
没看懂，但把楼主代码修改好了。

感谢！感谢！