代码中增加一个条件，求帮修改

hfvung · 发表于 2024-8-18 10:10

增加向右间隔11列写入，详情请看附件：

求修改代码X.rar (16.95 KB, 下载次数: 13)

quqiyuan · 发表于 2024-8-18 10:40

是这样子吗？仅供参考。。。

quqiyuan · 发表于 2024-8-18 10:41

代码如下。。。

Sub test() '原代码

Dim d As Object, arr
Set d = CreateObject("scripting.dictionary")
arr = [c2:d11]
For i = 1 To UBound(arr)
d(CStr(arr(i, 1))) = arr(i, 2)
Next
Brr = [j2:j30]
For i = 1 To UBound(Brr)
For j = 1 To UBound(Brr, 2)
If d.Exists(CStr(Brr(i, j))) Then Brr(i, j) = d(CStr(Brr(i, j)))
Next
Next
c = Cells(2, Columns.Count).End(1).Column
For i = 1 To c Step 10
Cells(2, 10 + i).Resize(UBound(Brr), UBound(Brr, 2)) = Brr
Next
Set d = Nothing
End Sub

hfvung · 发表于 2024-8-18 15:44

quqiyuan 发表于 2024-8-18 10:41
代码如下。。。

Sub test() '原代码

谢谢大神的代码，因定位的起始点在文档中没有讲清楚，在运用中就发现一些问题，请再费心出手帮助。详情请看附件。

求修改代码X1.rar (16.12 KB, 下载次数: 2)

quqiyuan · 发表于 2024-8-18 16:10

hfvung 发表于 2024-8-18 15:44
谢谢大神的代码，因定位的起始点在文档中没有讲清楚，在运用中就发现一些问题，请再费心出手帮助。详情 ...

改好了，请参考。。。

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

[求助] 代码中增加一个条件，求帮修改

评分

评分