求修改代码间隔固定列连续写入字符

hfvung · 发表于 2024-8-11 12:31

详情请看附件：

求修改代码AA.rar (14.27 KB, 下载次数: 9)

醉眼看尘世 · 发表于 2024-8-11 13:24

我怎么看不懂你的要求呢？直到数字0的前5列的第二行没有字符时，就不用写入，如红色单元格

jaxxcyh · 发表于 2024-8-11 13:29

Sub test()
Dim arr(9) As Integer
For i = LBound(arr) To UBound(arr)
arr(i) = i
Next
mycol = 9 '第9列即I列
n = 0
Do
If Cells(2, mycol) <> "" Then
Cells(1, mycol).Offset(0, 5).Resize(1, 10).Value = arr
mycol = mycol + 16
End If
n = n + 1
Loop Until n > 30
End Sub

复制代码

hfvung · 发表于 2024-8-11 13:32

醉眼看尘世发表于 2024-8-11 13:24
我怎么看不懂你的要求呢？直到数字0的前5列的第二行没有字符时，就不用写入，如红色单元格

如AT1，它的位置应该写入0，但当他前5列的第二行，也就是AO2没有字符，也就是空行的话，AT1就不用写0，包括AT1后面的也不用写入

jaxxcyh · 发表于 2024-8-11 13:32

文件在此...................................

jaxxcyh · 发表于 2024-8-11 13:33

Sub test()
Dim arr(9) As Integer
For i = LBound(arr) To UBound(arr)
arr(i) = i
Next
mycol = 9 '第9列即I列
n = 0
Do
If Cells(2, mycol) <> "" Then
Cells(1, mycol).Offset(0, 5).Resize(1, 10).Value = arr
mycol = mycol + 16
End If
n = n + 1
Loop Until n > 30
End Sub

复制代码

gwjkkkkk · 发表于 2024-8-11 17:23

Option Explicit
Sub TEST2()
Dim ar, i&, n&, iPosCol&

Application.ScreenUpdating = False

ReDim ar(0 To 9)
For i = 0 To UBound(ar)
      ar(i) = i
Next i
With [I1]
      For i = 1 To 30
         n = n + 1
         iPosCol = (n - 1) * 16 + 1
         If .Cells(2, iPosCol).Value <> Empty Then
            .Cells(1, iPosCol + 5).Resize(, 9) = ar
         Else
            Exit For
         End If
      Next i
End With

Application.ScreenUpdating = True
Beep
End Sub

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

[求助] 求修改代码间隔固定列连续写入字符

评分