序号换对应数据的问题

杨小妹

附件 序号换对应数据附件.rar (708.53 KB, 下载次数: 7)

2025-2-1 19:53 上传

点击文件名下载附件

谢谢老师！

gwjkkkkk

gwjkkkkk

请参考。。。

quqiyuan

参与一下，仅供参考。。。

quqiyuan

代码如下。。。
Sub test()
    Dim wb As Workbook, sht As Worksheet
    Set wb = ThisWorkbook
    For Each sht In wb.Sheets
        r = sht.Cells(Rows.Count, 5).End(3).Row
        arr = sht.[a1].Resize(r, 9)
        For i = 1 To UBound(arr)
            If arr(i, 9) <> Empty Then
                arr(i, 9) = arr(arr(i, 9), 5)
            End If
        Next
        sht.[a1].Resize(r, 9) = arr
    Next
    Beep
End Sub

杨小妹

谢谢各位老师帮助。没分了，明天补上。祝各位老师新春愉快，全家幸福安康！

桑榆非晚123

通过10分钟与AI的互动，得到了代码。想一起探讨AI自动化办公编程的，可以加我微信公众号ExcelAIhelper

1. Sub ReplaceIColumnWithEColumn_Optimized()  
   
2.     Dim ws As Worksheet  
   
3.     Dim lastRow As Long  
   
4.     Dim i As Long  
   
5.     Dim dataArrayI As Variant  
   
6.     Dim dataArrayE As Variant  
   
7.    
   
8.     ' 遍历所有工作表  
   
9.     For Each ws In ThisWorkbook.Worksheets  
   
10.         ' 找到当前工作表 E 列的最后一行  
    
11.         lastRow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row  
    
12.         
    
13.         ' 如果工作表没有数据，跳过  
    
14.         If lastRow < 1 Then GoTo NextSheet  
    
15.         
    
16.         ' 将 I 列和 E 列的数据加载到数组中  
    
17.         dataArrayI = ws.Range("I1:I" & lastRow).Value  
    
18.         dataArrayE = ws.Range("E1:E" & lastRow).Value  
    
19.         
    
20.         ' 遍历数组，替换 I 列的值为对应行 E 列的值  
    
21.         For i = 1 To lastRow  
    
22.             ' 将 I 列的值替换为对应行 E 列的值  
    
23.             dataArrayI(i, 1) = dataArrayE(i, 1)  
    
24.         Next i  
    
25.         
    
26.         ' 将修改后的数组写回 I 列  
    
27.         ws.Range("I1:I" & lastRow).Value = dataArrayI  
    
28.         
    
29. NextSheet:  
    
30.     Next ws  
    
31.    
    
32.     MsgBox "所有工作表的 I 列数据已替换完成！", vbInformation  
    
33. End Sub

复制代码

桑榆非晚123

第一次代码有问题，没有理解意思，现在已调试AI写出完整代码。有想研讨如何使用AI写代码的，可以关注我微信公众号【ExcelAIhelper】

1. Sub ReplaceIColumnWithEColumn_Corrected()  
   
2.     Dim ws As Worksheet  
   
3.     Dim lastRowE As Long, lastRowI As Long, lastRow As Long  
   
4.     Dim i As Long  
   
5.     Dim dataArrayI As Variant  
   
6.     Dim dataArrayE As Variant  
   
7.    
   
8.     ' 遍历所有工作表  
   
9.     For Each ws In ThisWorkbook.Worksheets  
   
10.         ' 找到当前工作表 E 列和 I 列的最后一行  
    
11.         lastRowE = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row  
    
12.         lastRowI = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row  
    
13.         lastRow = Application.Max(lastRowE, lastRowI) ' 取 E 列和 I 列的最大行号  
    
14.         
    
15.         ' 如果工作表没有数据，跳过  
    
16.         If lastRow < 1 Then GoTo NextSheet  
    
17.         
    
18.         ' 将 I 列和 E 列的数据加载到数组中  
    
19.         dataArrayI = ws.Range("I1:I" & lastRow).Value  
    
20.         dataArrayE = ws.Range("E1:E" & lastRow).Value  
    
21.         
    
22.         ' 遍历 I 列的数组，获取 I 列的值作为行号  
    
23.         For i = 1 To lastRow  
    
24.             If Not IsEmpty(dataArrayI(i, 1)) And IsNumeric(dataArrayI(i, 1)) Then  
    
25.                 ' 获取 I 列的值作为行号  
    
26.                 Dim targetRow As Long  
    
27.                 targetRow = CLng(dataArrayI(i, 1)) ' 将值转换为 Long 类型  
    
28.                
    
29.                 ' 检查行号是否在有效范围内  
    
30.                 If targetRow > 0 And targetRow <= lastRow Then  
    
31.                     ' 用 E 列对应行的值替换 I 列的值  
    
32.                     dataArrayI(i, 1) = dataArrayE(targetRow, 1)  
    
33.                 Else  
    
34.                     ' 如果行号无效，可以选择清空或保留原值  
    
35.                     dataArrayI(i, 1) = Empty  
    
36.                 End If  
    
37.             Else  
    
38.                 ' 如果 I 列的值不是数字，清空或保留原值  
    
39.                 dataArrayI(i, 1) = Empty  
    
40.             End If  
    
41.         Next i  
    
42.         
    
43.         ' 将修改后的数组写回 I 列  
    
44.         ws.Range("I1:I" & lastRow).Value = dataArrayI  
    
45.         
    
46. NextSheet:  
    
47.     Next ws  
    
48.    
    
49.     MsgBox "所有工作表的 I 列数据已替换完成！", vbInformation  
    
50. End Sub

复制代码