Question

我有一个Excel项目列表。每个项目都有三行（行为，计划，功能说明）和许多列（一列=一个月）。

我想做的是：

A）为D列中的每个唯一值（项目＃）添加两行|完成

B）减去计划-新行之一中的实际值

C）减去fcst-新行的秒数中的实际值

A *）创建两个新行并复制 D列中每个唯一值的A：AE列中的数据（项目编号） |可选-我可以处理选项A），但是A *会更好。

有人知道如何编写代码来执行B，C，A *点吗？我不知道如何解决。

这是我希望看到的最终输出（黄色和橙色行是我希望宏为D列中每个唯一项目＃创建的新行）： Final_Output

对于每个项目，AF中的文本始终为“计划$ 000”或“实际$ 000”或“预测$ 000”（即，每个项目都有这三行；不少于，不多于）。

数据根据影响＃（列D）进行排序。意味着前三行与项目＃123相关，接下来的三行与项目＃129相关，接下来的三行与项目＃761相关，等等。

只要获得期望的结果，我们就可以播放（排序，过滤等）数据。：-）

下面是我现在拥有的代码...相当糟糕：

Sub CreateAndCompare() 
Dim rng As Range
Dim cl As Range
Dim dic As Object
Dim ky As Variant
Set dic = CreateObject("Scripting.Dictionary")

With Sheets("Impact")
    Set rng = .Range(.Range("D2"), .Range("D" & .Rows.Count).End(xlUp))
End With

For Each cl In rng
    If Not dic.exists(cl.Value) Then
        dic.Add cl.Value, cl.Value
    End If
Next cl

For Each ky In dic.keys
      lastrow = ActiveSheet.Range("d2").CurrentRegion.Rows.Count
      Cells(lastrow + 1, 4).Value = dic(ky)
      Cells(lastrow + 2, 4).Value = dic(ky)


Next ky

End Sub

谢谢！

Answer 1

我想我已经找到了解决方案。 :-)

我创建了一个额外的列AG，用于合并Impact＃和目的（D＆AF列）。

但是，执行代码大约需要15分钟。

有人能建议我做些什么以使其更快吗？

Sub CreateAndCompare()
Dim rng As Range
Dim cl As Range
Dim dic As Object
Dim ky As Variant

    Set dic = CreateObject("Scripting.Dictionary")

    With Sheets("Impact")
        Set rng = .Range(.Range("D2"), .Range("D" & .Rows.Count).End(xlUp))
    End With

    For Each cl In rng
        If Not dic.exists(cl.Value) Then
            dic.Add cl.Value, cl.Value
        End If
    Next cl

    For Each ky In dic.keys
          lastrow = ActiveSheet.Range("d2").CurrentRegion.Rows.Count
          Cells(lastrow + 1, 4).Value = dic(ky)
          Cells(lastrow + 1, 32).Value = "Act-Plan"
          Cells(lastrow + 1, 33).Value = "Plan $000's"


          For i = 2 To 43
          mylookupvalue = Cells(lastrow + 1, 4) & "Actual $000's"
          mylookupvalue_2 = Cells(lastrow + 1, 4) & Cells(lastrow + 1, 33)
          myfirstcolumn = 33
          mylastcolumn = 43
          mycolumnIndex = i
          myfirstrow = 2
          mylastrow = lastrow
          mytablearray = Worksheets("Impact").Range(Cells(myfirstrow, myfirstcolumn), Cells(mylastrow, mylastcolumn))

          On Error Resume Next

          value_1 = Application.WorksheetFunction.VLookup(mylookupvalue, mytablearray, mycolumnIndex, False)
          value_2 = Application.WorksheetFunction.VLookup(mylookupvalue_2, mytablearray, mycolumnIndex, False)

          Cells(lastrow + 1, i + 32).Value = value_1 - value_2

          Cells(lastrow + 2, 4).Value = dic(ky)
          Cells(lastrow + 2, 32).Value = "Act-Fcst"
          Cells(lastrow + 2, 33).Value = "Forecast $000's"

          mylookupvalue_3 = Cells(lastrow + 2, 4) & "Actual $000's"
          mylookupvalue_4 = Cells(lastrow + 2, 4) & Cells(lastrow + 2, 33)

          value_3 = Application.WorksheetFunction.VLookup(mylookupvalue_3, mytablearray, mycolumnIndex, False)
          value_4 = Application.WorksheetFunction.VLookup(mylookupvalue_4, mytablearray, mycolumnIndex, False)

          Cells(lastrow + 2, i + 32).Value = value_3 - value_4

          Next i

    Next ky

    Worksheets("Impact").Range("AH2:BW10024").NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"

End Sub

Answer 2

我建议以下内容：

遍历所有数据行
查找行计划/实际/预测的当前影响否
然后将计算结果写到工作表的末尾

所以您最终会得到类似的东西：

Option Explicit

Public Sub CreateAndCompare()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Impact")

    'we assume here that the sheet is already sorted by column D "Impact #"

    Dim LastDataRow As Long 'find last used row
    LastDataRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row

    Dim LastDataColumn As Long 'find last used column
    LastDataColumn = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

    Dim NextEmptyRow As Long
    NextEmptyRow = LastDataRow + 1

    Dim iRow As Long, PlanRow As Long, ActualRow As Long, ForcastRow As Long
    For iRow = 2 To LastDataRow 'loop through all data rows
        Select Case ws.Cells(iRow, "AF").Value 'check which row type the current iRow is and remember
            Case "Plan $000's":     PlanRow = iRow
            Case "Actual $000's":   ActualRow = iRow
            Case "Forecast $000's": ForcastRow = iRow
        End Select

        'detect change of impact no
        If ws.Cells(iRow, "D").Value <> ws.Cells(iRow + 1, "D").Value Or iRow = LastDataRow Then
            'check if plan/actual/forecast rows were found (if one is missing we cannot calculate
            If PlanRow > 0 And ActualRow > 0 And ForcastRow > 0 Then
                'copy column A-AE to next 2 empty rows
                ws.Cells(NextEmptyRow, "A").Resize(RowSize:=2, ColumnSize:=31).Value = ws.Cells(iRow, "A").Resize(ColumnSize:=31).Value

                'write purpose
                ws.Cells(NextEmptyRow, "AF").Value = "Act - Plan"
                ws.Cells(NextEmptyRow + 1, "AF").Value = "Act - Fcst"

                'calculate
                Dim iCol As Long
                For iCol = 33 To LastDataColumn
                    ws.Cells(NextEmptyRow, iCol).Value = ws.Cells(ActualRow, iCol).Value - ws.Cells(PlanRow, iCol).Value
                    ws.Cells(NextEmptyRow + 1, iCol).Value = ws.Cells(ActualRow, iCol).Value - ws.Cells(ForcastRow, iCol).Value
                Next iCol


                NextEmptyRow = NextEmptyRow + 2 'initialize for next impact no
            End If

            PlanRow = 0: ActualRow = 0: ForcastRow = 0 'initialize for next impact no
        End If
    Next iRow
End Sub

为列中的每个唯一值创建两行并减去

2 个答案: