第一个程序没问题，就是逻辑还没捋顺

第二程序的功能有问题，需要参考第一个进行修改

 

Sub tss()


m = 2
For i = 2 To 100

If Cells(i, 12) <> "" Then

j = i
Do While Cells(j, 13) = ""

j = j + 1
Loop

If j - i < 3 Then

Cells(m, 18) = j: Cells(m, 17) = i:
Else
m = m - 1:

End If

m = m + 1

End If



Next



End Sub
Sub 数据导入()

n = 500  '数据量

 Sheets("shuju3").Cells(1, 1).Resize(1, 15).Copy Sheets("Sheet4").Cells(1, 1).Resize(1, 15)

 Sheets("shuju3").Cells(20000, 1).Resize(n, 15).Copy Sheets("Sheet4").Cells(2, 1).Resize(n, 15)

End Sub


Sub ts2()

On Error Resume Next

n = Cells(Rows.Count, 2).End(xlUp).Row

arr = Cells(2, 2).Resize(n - 1, 14)

For i = 2 To n

If arr(i, 11) <> "" Then

j = i
Do While arr(j, 12) = "" And j - i < 3

arr(i, 12) = arr(j, 12): arr(i, 13) = arr(j, 13): arr(i, 14) = arr(j, 14):
j = j + 1

Loop

End If
Debug.Print i
Next

 Cells(2, 2).Resize(n - 1, 14) = arr

End Sub