Друзья привет, Есть макрос, который проходится по паре, связанных между собой листов. Во вспомогательном листе он берет из столбца А слово из ячейки начиная с А2, А3 и т.д. Затем он заходит на основной лист и ищет в столбце I вхождение этого слова и возвращает на вспомогательный лист сумму найденных значений в других столбцах (K, N, O). Что мне надо написать в этот макрос чтобы я мог задать в коде вручную пары этих листов дополнительно, по которым он бы прошелся? Пары, вот они: (BW, BW ACOS), (BO, BO ACOS), (BS, BS ACOS), (SHAMPCOND, SHAMPCOND ACOS), (HW, HW ACOS), (SKN, SKN ACOS), (SLT, SLT ACOS). Вот макрос сам: [vba]
Код
Sub CombineAndSummarizeDataWithACOS() Dim endingSheet As Worksheet Dim startSheet As Worksheet Dim endingLastRow As Long Dim startLastRow As Long Dim endingRange As Range Dim startRange As Range Dim endingCell As Range Dim startCell As Range Dim keyword As String Dim spendSum As Double Dim salesSum As Double Dim resultSpendColumn As Long Dim resultSalesColumn As Long Dim resultACOSColumn As Long Dim resultRow As Long Dim sourceSheet As Worksheet Dim destinationSheet As Worksheet Dim lastRowSource As Long Dim lastRowDestination As Long Dim sourceRange As Range Dim cell As Range Dim wordsDict As Object Dim searchTerm As String Dim totalClicks As Double Dim i As Long
' Set the 'Ending' and 'Start' sheets Set endingSheet = ThisWorkbook.Sheets("BW_MEN ACOS") ' Change to your 'Ending' sheet name Set startSheet = ThisWorkbook.Sheets("BW_MEN") ' Change to your 'Start' sheet name
' Find the last rows in the 'Ending' and 'Start' sheets endingLastRow = endingSheet.Cells(endingSheet.Rows.Count, "A").End(xlUp).row startLastRow = startSheet.Cells(startSheet.Rows.Count, "I").End(xlUp).row
' Set the ranges to iterate through Set endingRange = endingSheet.Range("A2:A" & endingLastRow) ' Assuming data starts from row 2 Set startRange = startSheet.Range("I2:O" & startLastRow) ' Assuming data starts from row 2
' Set the result columns on the 'Ending' sheet resultSpendColumn = 3 ' Column C resultSalesColumn = 4 ' Column D resultACOSColumn = 5 ' Column E resultRow = 2
' Loop through each cell in the 'Ending' range For Each endingCell In endingRange keyword = endingCell.Value spendSum = 0 salesSum = 0
' Loop through each cell in the 'Start' range and apply filtering For Each startCell In startRange If InStr(1, CStr(startCell.Value), keyword, vbTextCompare) > 0 Then spendSum = spendSum + startCell.Offset(0, 5).Value ' Assuming Spend values are in column N salesSum = salesSum + startCell.Offset(0, 6).Value ' Assuming Sales values are in column O End If Next startCell
' Write the sums in the result columns on the 'Ending' sheet endingSheet.Cells(resultRow, resultSpendColumn).Value = spendSum endingSheet.Cells(resultRow, resultSalesColumn).Value = salesSum
' Calculate ACOS for the current keyword If salesSum <> 0 Then endingSheet.Cells(resultRow, resultACOSColumn).Formula = "=IFERROR(" & _ endingSheet.Cells(resultRow, resultSpendColumn).Address & "/" & _ endingSheet.Cells(resultRow, resultSalesColumn).Address & ", 0)" Else endingSheet.Cells(resultRow, resultACOSColumn).Value = 0 End If
resultRow = resultRow + 1 Next endingCell
' Set the source and destination sheets for the second part of the macro Set sourceSheet = ThisWorkbook.Sheets("BW_MEN") ' Change to your source sheet name Set destinationSheet = ThisWorkbook.Sheets("BW_MEN ACOS") ' Change to your destination sheet name
' Find the last row in column I on the source sheet lastRowSource = sourceSheet.Cells(sourceSheet.Rows.Count, "I").End(xlUp).row
' Find the last row in column A on the destination sheet lastRowDestination = destinationSheet.Cells(destinationSheet.Rows.Count, "A").End(xlUp).row
' Set the source range Set sourceRange = sourceSheet.Range("I2:K" & lastRowSource) ' Assuming data starts from row 2
' Loop through each cell in column A on the destination sheet For i = 2 To lastRowDestination ' Get the search term from the current cell in column A searchTerm = destinationSheet.Cells(i, 1).Value
' Reset totalClicks for each search term totalClicks = 0
' Loop through each cell in the source range For Each cell In sourceRange.Rows Dim customerSearchTerm As String customerSearchTerm = cell.Cells(1, 1).Value
If InStr(1, customerSearchTerm, searchTerm, vbTextCompare) > 0 Then totalClicks = totalClicks + cell.Cells(1, 3).Value ' Assuming clicks are in column K End If Next cell
' Write the total clicks to the adjacent cell in column B on the destination sheet destinationSheet.Cells(i, 2).Value = totalClicks Next i End Sub
[/vba]
Друзья привет, Есть макрос, который проходится по паре, связанных между собой листов. Во вспомогательном листе он берет из столбца А слово из ячейки начиная с А2, А3 и т.д. Затем он заходит на основной лист и ищет в столбце I вхождение этого слова и возвращает на вспомогательный лист сумму найденных значений в других столбцах (K, N, O). Что мне надо написать в этот макрос чтобы я мог задать в коде вручную пары этих листов дополнительно, по которым он бы прошелся? Пары, вот они: (BW, BW ACOS), (BO, BO ACOS), (BS, BS ACOS), (SHAMPCOND, SHAMPCOND ACOS), (HW, HW ACOS), (SKN, SKN ACOS), (SLT, SLT ACOS). Вот макрос сам: [vba]
Код
Sub CombineAndSummarizeDataWithACOS() Dim endingSheet As Worksheet Dim startSheet As Worksheet Dim endingLastRow As Long Dim startLastRow As Long Dim endingRange As Range Dim startRange As Range Dim endingCell As Range Dim startCell As Range Dim keyword As String Dim spendSum As Double Dim salesSum As Double Dim resultSpendColumn As Long Dim resultSalesColumn As Long Dim resultACOSColumn As Long Dim resultRow As Long Dim sourceSheet As Worksheet Dim destinationSheet As Worksheet Dim lastRowSource As Long Dim lastRowDestination As Long Dim sourceRange As Range Dim cell As Range Dim wordsDict As Object Dim searchTerm As String Dim totalClicks As Double Dim i As Long
' Set the 'Ending' and 'Start' sheets Set endingSheet = ThisWorkbook.Sheets("BW_MEN ACOS") ' Change to your 'Ending' sheet name Set startSheet = ThisWorkbook.Sheets("BW_MEN") ' Change to your 'Start' sheet name
' Find the last rows in the 'Ending' and 'Start' sheets endingLastRow = endingSheet.Cells(endingSheet.Rows.Count, "A").End(xlUp).row startLastRow = startSheet.Cells(startSheet.Rows.Count, "I").End(xlUp).row
' Set the ranges to iterate through Set endingRange = endingSheet.Range("A2:A" & endingLastRow) ' Assuming data starts from row 2 Set startRange = startSheet.Range("I2:O" & startLastRow) ' Assuming data starts from row 2
' Set the result columns on the 'Ending' sheet resultSpendColumn = 3 ' Column C resultSalesColumn = 4 ' Column D resultACOSColumn = 5 ' Column E resultRow = 2
' Loop through each cell in the 'Ending' range For Each endingCell In endingRange keyword = endingCell.Value spendSum = 0 salesSum = 0
' Loop through each cell in the 'Start' range and apply filtering For Each startCell In startRange If InStr(1, CStr(startCell.Value), keyword, vbTextCompare) > 0 Then spendSum = spendSum + startCell.Offset(0, 5).Value ' Assuming Spend values are in column N salesSum = salesSum + startCell.Offset(0, 6).Value ' Assuming Sales values are in column O End If Next startCell
' Write the sums in the result columns on the 'Ending' sheet endingSheet.Cells(resultRow, resultSpendColumn).Value = spendSum endingSheet.Cells(resultRow, resultSalesColumn).Value = salesSum
' Calculate ACOS for the current keyword If salesSum <> 0 Then endingSheet.Cells(resultRow, resultACOSColumn).Formula = "=IFERROR(" & _ endingSheet.Cells(resultRow, resultSpendColumn).Address & "/" & _ endingSheet.Cells(resultRow, resultSalesColumn).Address & ", 0)" Else endingSheet.Cells(resultRow, resultACOSColumn).Value = 0 End If
resultRow = resultRow + 1 Next endingCell
' Set the source and destination sheets for the second part of the macro Set sourceSheet = ThisWorkbook.Sheets("BW_MEN") ' Change to your source sheet name Set destinationSheet = ThisWorkbook.Sheets("BW_MEN ACOS") ' Change to your destination sheet name
' Find the last row in column I on the source sheet lastRowSource = sourceSheet.Cells(sourceSheet.Rows.Count, "I").End(xlUp).row
' Find the last row in column A on the destination sheet lastRowDestination = destinationSheet.Cells(destinationSheet.Rows.Count, "A").End(xlUp).row
' Set the source range Set sourceRange = sourceSheet.Range("I2:K" & lastRowSource) ' Assuming data starts from row 2
' Loop through each cell in column A on the destination sheet For i = 2 To lastRowDestination ' Get the search term from the current cell in column A searchTerm = destinationSheet.Cells(i, 1).Value
' Reset totalClicks for each search term totalClicks = 0
' Loop through each cell in the source range For Each cell In sourceRange.Rows Dim customerSearchTerm As String customerSearchTerm = cell.Cells(1, 1).Value
If InStr(1, customerSearchTerm, searchTerm, vbTextCompare) > 0 Then totalClicks = totalClicks + cell.Cells(1, 3).Value ' Assuming clicks are in column K End If Next cell
' Write the total clicks to the adjacent cell in column B on the destination sheet destinationSheet.Cells(i, 2).Value = totalClicks Next i End Sub
Serge_007, Приветствую вас! У меня тоже тут (на данном форуме) бывало что не помещалось сообщение в пост. Хотя в счётчике символов выдавало что оставалось ещё 3,5К символов свободно. Приходилось урезать текст поста или же вовсе выкладывал только файл пример. Пару раз 100% было.
Serge_007, Приветствую вас! У меня тоже тут (на данном форуме) бывало что не помещалось сообщение в пост. Хотя в счётчике символов выдавало что оставалось ещё 3,5К символов свободно. Приходилось урезать текст поста или же вовсе выкладывал только файл пример. Пару раз 100% было.MikeVol
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
