|
- Option Explicit
- Sub Test()
- Dim shAll As Worksheet, shKPI As Worksheet
- Dim arr As Variant, arrResult As Variant
- Dim lngRow As Long, lngRows As Long
- Dim lngIndex As Long
-
- ''''''''''''''''''''''''''''''''''''''''''''
- lngIndex = 1
- ReDim arrResult(1 To 6, 1 To 1)
- arrResult(1, 1) = "Staff"
- arrResult(2, 1) = "Sales"
- arrResult(3, 1) = "QA"
- arrResult(4, 1) = "ACHT"
- arrResult(5, 1) = "CTS"
- arrResult(6, 1) = "KPI"
-
- ''''''''''''''''''''''''''''''''''''''''''''
-
- For Each shKPI In Sheets
- If shKPI.Name <> "ALL" Then
- lngRows = shKPI.Range("O" & Rows.Count).End(xlUp).Row
- arr = shKPI.Range("A1:P" & lngRows)
- For lngRow = LBound(arr) To UBound(arr)
- If CStr(arr(lngRow, 9)) = "Month" Then
- lngIndex = lngIndex + 1
- ReDim Preserve arrResult(1 To 6, 1 To lngIndex)
- arrResult(1, lngIndex) = arr(lngRow - 2, 2)
- arrResult(2, lngIndex) = arr(lngRow, 16)
- arrResult(3, lngIndex) = arr(lngRow + 1, 16)
- arrResult(4, lngIndex) = arr(lngRow + 2, 16)
- arrResult(5, lngIndex) = arr(lngRow + 3, 16)
- arrResult(6, lngIndex) = arr(lngRow + 4, 16)
- End If
- Next
- End If
- Next
-
- arrResult = Application.WorksheetFunction.Transpose(arrResult)
-
- Set shAll = Sheets("ALL")
- shAll.UsedRange.ClearContents
- shAll.Range("A1").Resize(UBound(arrResult), 6) = arrResult
- End Sub
复制代码 |
评分
-
1
查看全部评分
-
|