4X7矩阵如何建立数据透视表

sisusum

我打开excel，程式码还在，还是按钮不见了，不知道怎样重做一个新按钮能运行这些代码？

Private Sub MergeTbl_Click()
    Dim arr(1 To 4) As String
    Dim tempArr()
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim m As Integer
    Dim intRows As Long
    Dim strSheetName As String
'    Application.ScreenUpdating = False
    j = 1
    m = 1
    For i = 1 To ActiveWorkbook.Sheets.Count
        strSheetName = ActiveWorkbook.Sheets(i).Name
        Select Case strSheetName
        Case "A", "B", "C", "D"
            arr(j) = strSheetName
            j = j + 1
        End Select
    Next
    intRows = (Worksheets(arr(1)).Range("A" & 4 ^ 8).End(xlUp).Row - 2) * UBound(arr)
    Range(Cells(2, 1), Cells(intRows + 1, 9)).ClearContents
    ReDim tempArr(1 To intRows, 1 To 8)
    Range("A2") = m
    For i = 1 To intRows
        k = i Mod UBound(arr)
        If k = 0 Then
            k = UBound(arr)
        End If
        tempArr(i, 1) = arr(k)
        For j = 2 To 8
            tempArr(i, j) = Worksheets(arr(k)).Cells(m + 2, j - 1)
        Next
        If i Mod UBound(arr) = 0 Then
            m = m + 1
            If m <= intRows / UBound(arr) Then
                Range("A" & 2 + i) = m
            End If
        End If
    Next
    Range("B2").Resize(intRows, 8) = tempArr
'    Application.ScreenUpdating = True
End Sub

Henry D. Sy

那就重新建一个按钮呀

sisusum

谢谢!