如何添加来自不同工作表的值，并保留指向工作表+单元格的公式？

Question

我正在尝试将不同工作表（工作表 2 到工作表 5）中的值添加到我的主工作表（工作表 1）中。在工作表 1 中，我希望单元格包含指向不同工作表的正确公式（如果可能）。

通常是这样的：

='Sheet2'!D5+'Sheet3'!D165

我所有的床单都有不同的产品，但有些床单包含相同的产品。所以我想搜索所有这些并将它们添加到我的主表（表 1）中。

Sub UpdateMainSheet()
' Kode for å Oppdatere Plukkeliste Alle Artikler Summert
Dim AktivtArk As String
Dim AktivtArkNavn As String
Dim K As Integer
Dim Count As Integer

'Line of code to delete old data in Main Sheet:
Worksheets("Sheet1").Range("A2:H10000").Clear

AktivtArkOverskrift = "List of Articles from Sheet 2 to 5"
'Creates Headline in Main Sheet:
eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Worksheets("Sheet1").Cells(eRow, 1) = AktivtArkOverskrift
Worksheets("Sheet1").Cells(eRow, 1).Font.Bold = True

'Script to check and gather data from the other sheets (Sheet 2, 3, 4 and 5):
For K = 2 To 5
    'For loop to check each line in sheet "K"
    For I = 2 To 1000
        'If function to check if the cell I in column F is empty, if so it_jumps to next row and do the same check:
        If Worksheets(K).Cells(I, 6) > 0 Then
        Count = 0
            'For loop to check if I already have a row in the Main Sheet with the article I'm checking:
            For L = 2 To 1000
                'If function to check if the articles have the same article number:
                If Worksheets(K).Cells(I, 1) = Worksheets("Sheet1").Cells(L, 1) Then
                    'Line of code that are supposed to ADD the values that is currently in the Main Sheet, togheter with the value in Sheet K:
                    Worksheets("Sheet1").Cells(I, 4).Formula = Worksheets("Sheet1").Cells(I, 4) + Worksheets(K).Cells(L, 4)
                End If
            Next L
        End If
    Next I
Next K

End Sub

所以我需要在我的代码中修复这部分（位于 For 循环内最远的地方）：

Worksheets("Sheet1").Cells(I, 4).Formula = Worksheets("Sheet1").Cells(I, 4) + Worksheets(K).Cells(L, 4)

让它在想要的单元格中创建一个公式，看起来像这样：

='Sheet2'!D5+'Sheet3'!D165

它还必须能够添加另一个单元格，因为循环正在运行可能包含相同产品的多个工作表（工作表 2 到 5）。 IE。对于每个产品，我只希望在我的主表中有一行。

Answer 1

我最终设法找到了解决方案。 似乎我在某些循环中切换了 L 和 I，这导致这些值不能相加。

以下代码（我没有翻译成英文，但如果有人想要/需要，可以这样做）解决了我的问题，并给了我从 Sheet 2 到 Sheet 5 的值，按 Sheet 1 中的产品排序：

Sub OppdaterePlukkelisteSummert()
'Kode for å Oppdatere Plukkeliste Alle Artikler Summert
Dim AktivtArk As String
Dim AktivtArkNavn As String
Dim K As Integer
Dim Teller As Integer
Dim value1 As Integer
Dim value2 As Integer


'Sletter Plukklisten for å oppdatere og sortere på nytt:
Worksheets(1).Range("A2:H10000").Clear


'HENTING AV DATA FRA ARKET "K":
AktivtArk = "Artikler Summert fra Alle Ark"
AktivtArkOverskrift = "Artikler Summert fra Alle Ark"
'Setter inn Overskrift som Forteller kva ark utstyret kommer fra:
eRow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Worksheets(1).Cells(eRow, 1) = AktivtArkOverskrift
Worksheets(1).Cells(eRow, 1).Font.Bold = True
'Sjekker hvilke/hvilket rader/utstyr som skal plukkes, og legger det inn i "Ark1":
For K = 2 To 5
    For I = 2 To 1000
        If Worksheets(K).Cells(I, 6) > 0 Then
        Teller = 0
            For L = 2 To 1000
                If Worksheets(K).Cells(I, 1) = Worksheets(1).Cells(L, 1) Then
                    value1 = Worksheets(1).Cells(L, 4)
                    value2 = Worksheets(K).Cells(I, 4)
                    Worksheets(1).Cells(L, 4) = value1 + value2
                    Worksheets(1).Cells(L, 6) = value1 + value2
                Else
                    Teller = Teller + 1
                End If
            Next L
            If Teller > 998 Then
                eRow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                For J = 1 To 11
                    Worksheets(1).Cells(eRow, J) = Worksheets(K).Cells(I, J)
                Next J
                Worksheets(1).Cells(eRow, 6).Font.Color = RGB(0, 150, 0)
                Worksheets(1).Cells(eRow, 7).Font.Color = RGB(0, 150, 0)
            End If
        End If
    Next I
Next K

Worksheets(1).Range("A2").Select
End Sub

我希望这对其他人有用:-) 感谢 cmets 中的所有帮助和建议！

Answer 2

我打算用这个简单的例子来说明：

I = 1 'for example

For K = 2 To 5
    Worksheets("Sheet1").Cells(I, 4).Value = Worksheets("Sheet1").Cells(I, 4).Value + _
        WorksheetFunction.SumIf(Worksheets(K).Range("A:A"), "Bananas", Worksheets(K).Range("D:D"))
Next K