Как добавить значения из разных листов и сохранить формулу, указывающую на листы + ячейки? - PullRequest
Новая
       31

Как добавить значения из разных листов и сохранить формулу, указывающую на листы + ячейки?

0 голосов
/ 11 января 2019

Я пытаюсь добавить значения из разных листов (лист 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 Loop): 

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

И заставьте его создать формулу в нужной ячейке, которая будет выглядеть примерно так: 

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

Он также должен иметь возможность добавить еще одну ячейку, поскольку цикл проходит через несколько листов (листы 2–5), которые могут содержать одинаковые продукты. То есть Мне нужна только одна строка в моем основном листе для каждого продукта.

Ответы [ 2 ]

0 голосов
/ 11 января 2019

Я собирался проиллюстрировать это простым примером: 

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
0 голосов
/ 11 января 2019

Мне удалось найти решение в конце концов. Казалось, я переключил L и I в сом цикла, что привело к значениям, которые не будут добавлены вместе.

Следующий код (я не переводил на английский, но могу сделать это, если кто-то хочет / нуждается в нем) решил мою проблему и дал мне значения от Листа 2 до 5, отсортированные по продукту Листа 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

Я надеюсь, что это может быть полезно для кого-то еще :-) Все помощь и предложения в комментариях приветствуются!

...