Question

每次运行以下代码时，此代码中缺少什么来增加摘要表中的列索引？

    Sub Worksheets_Summary()
    Dim OldSheet As Worksheet
    Dim NewSheet As Worksheet
    Dim Cell As Range
    Dim ColNum As Integer
    Dim RwNum As Long
    Dim book As Workbook
    Set book = ThisWorkbook
    Set NewSheet = book.Worksheets("Summary")
    NewSheet.Rows("2:" & NewSheet.Rows.Count).Clear

    RwNum = 1

    For Each OldSheet In book.Worksheets
        If OldSheet.Name <> "Summary" Then
            Range("B1").Value = Now()  'Change B1
            ColNum = 1
            RwNum = RwNum + 1

            NewSheet.Cells(RwNum, 1).Formula _
        = "=HYPERLINK(""#""&CELL(""address"",'" & OldSheet.Name & "'!A1)," _
             & """" & OldSheet.Name & """)"

            For Each Cell In OldSheet.Range("B11")  
                ColNum = ColNum + 1
                NewSheet.Cells(RwNum, ColNum).Formula = _
                "='" & OldSheet.Name & "'!" & Cell.Address(False, False)
            Next Cell

        End If
    Next OldSheet

    NewSheet.UsedRange.Columns.AutoFit


    End With
    End Sub

结果应该与附图中的摘要表相似。我们第一次运行宏：数据将显示在B列中第二次：在C栏等，..

有什么想法吗？

更新数据：

Answer 1

不是将列号硬编码为1，然后将其增加一次为2，而是需要根据已填充的列设置要更新的列号，并仅执行一次计算（在循环工作表之前。）

Sub Worksheets_Summary()
    Dim OldSheet As Worksheet
    Dim NewSheet As Worksheet
    Dim Cell As Range
    Dim ColNum As Integer
    Dim RwNum As Long
    Dim book As Workbook
    Set book = ThisWorkbook
    Set NewSheet = book.Worksheets("Summary")

    'The next statement seems to be ... wrong.  Each time you run the macro it will clear
    'all the previous days' values, but your question seems to imply that the summary
    'is meant to be a storage of the value of cell B11 of your other sheets as at
    'whatever times you run the macro.
    'NewSheet.Rows("2:" & NewSheet.Rows.Count).Clear

    RwNum = 1
    ColNum = NewSheet.Cells(1, NewSheet.Columns.Count).End(xlToLeft).Column + 1

    'No point setting the header for each sheet - just do it once
    NewSheet.Cells(1, ColNum).Value = Now()  'Change B1

    For Each OldSheet In book.Worksheets
        If OldSheet.Name <> "Summary" Then
            RwNum = RwNum + 1

            NewSheet.Cells(RwNum, 1).Formula _
        = "=HYPERLINK(""#""&CELL(""address"",'" & OldSheet.Name & "'!A1)," _
             & """" & OldSheet.Name & """)"

            'I *THINK* this next loop    
            'For Each Cell In OldSheet.Range("B11")  
            '    NewSheet.Cells(RwNum, ColNum).Formula = _
            '    "='" & OldSheet.Name & "'!" & Cell.Address(False, False)
            'Next Cell
            'which will generate formulas of ='UPS A'!B11 in every column of the
            'UPS A row (all of which will evaluate to the same thing)
            ' is simply intended to be
            NewSheet.Cells(rwNum, ColNum).Value = OldSheet.Range("B11").Value
        End If
    Next OldSheet

    NewSheet.UsedRange.Columns.AutoFit

End Sub

使用命令按钮的摘要工作表

1 个答案: