|
|
Sub QS()
Dim arr As Variant
Dim jg(1 To 10000, 1 To 10)
Dim i As Integer, j As Integer, k As Integer
Dim pgdn As String, mc As String, cz As String
arr = [a1].CurrentRegion.Value
For i = 1 To UBound(arr) - 1
If arr(i, 1) = "派工单" Then
pgdn = arr(i + 1, 1)
mc = arr(i + 2, 2)
cz = arr(i + 5, 2)
i = i + 6
End If
For j = 3 To UBound(arr, 2)
If arr(i, j) = "高度" And arr(i + 1, j) > 0 Then
k = k + 1
jg(k, 1) = pgdn
jg(k, 2) = mc
jg(k, 3) = cz
jg(k, 5) = arr(i, j - 2)
jg(k, 6) = arr(i + 1, j)
jg(k, 7) = arr(i + 1, j + 1)
jg(k, 8) = arr(i + 1, j + 2)
jg(k, 9) = arr(i + 1, j + 3)
jg(k, 10) = arr(i + 1, j + 4)
j = j + 4
End If
Next
Next
If k > 0 Then
[w2].CurrentRegion.Offset(1).ClearContents
[w3].Resize(k, 10).Value = jg
End If
End Sub |
|
