[已解决]自已太菜两天没搞定， 求助大神老师帮帮忙做到文件去

yochlee

谢谢grf1973老师，您写的代码我研究了一天，终于搞定了谢谢老师

yochlee

yochlee 发表于 2017-5-22 21:50
老师您这太深了，我原表就差这么点过不来，您再帮我看下改好来好么
1、循表改成从表大于几开 ...

谢谢grf1973老师，您写的代码我研究了一天，终于搞定了谢谢老师

雄鹰2013

Sub 统计()
Dim arr, brr(1 To 1000, 1 To 23)
Dim m
For k = 6 To Sheets.Count
     r = Sheets(k).Cells(Rows.Count, 1).End(xlUp).Row
     arr = Sheets(k).Range("a1:w" & r)
     For i = i + 1 To UBound(arr)
         If arr(i, 1) Like "工段?" Then
            x = i
            Do While arr(i, 2) <> ""
               n = n + 1
               m = 4
               brr(n, 1) = Sheets(k).Range("c1")
               brr(n, 2) = Sheets(k).Range("h1")
               brr(n, 3) = arr(x, 1)
               brr(n, 4) = arr(i, 2)
               For j = 3 To 16 Step 2
                   m = m + 1
                   brr(n, m) = arr(i, j)
               Next j
               For j = 17 To 23
                   m = m + 1
                   brr(n, m) = arr(i, j)
               Next j
               i = i + 1
            Loop
        End If
    Next i
Next k
Sheets("自动统计").Range("a4").Resize(n, 23) = brr
End Sub