Здравствуйте друзья, у меня вопрос теоретический скорее, так как не могу скинуть рабочий файл по некоторым причинам. Вот мой макрос который я юзаю для подсчет уникальных слов в списке слов на другом листе: [vba]
Код
Sub StatisticForEachWord() Dim sourceSheet As Worksheet Dim destinationSheet As Worksheet Dim lastRow As Long Dim sourceRange As Range Dim cell As Range Dim wordsDict As Object Dim wordCombination As String Dim clicks As Double
' Set the source and destination sheets Set sourceSheet = ThisWorkbook.Sheets("Sheet1") ' Change to your source sheet name Set destinationSheet = ThisWorkbook.Sheets("Sheet2") ' Change to your destination sheet name
' Find the last row in column I lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "I").End(xlUp).Row
' Set the source range Set sourceRange = sourceSheet.Range("I2:K" & lastRow) ' Assuming data starts from row 2
' Create a dictionary to store words and their statistics Set wordsDict = CreateObject("Scripting.Dictionary")
' Loop through each cell in the source range For Each cell In sourceRange.Rows wordCombination = cell.Cells(1, 1).Value clicks = cell.Cells(1, 3).Value ' Assuming clicks are in column K
' Split word combination into individual words Dim words() As String words = Split(wordCombination, " ")
' Create a dictionary to track unique words in this cell Dim cellWordsDict As Object Set cellWordsDict = CreateObject("Scripting.Dictionary")
For Each word In words word = Trim(word) If Not cellWordsDict.Exists(word) Then cellWordsDict.Add word, True If Not wordsDict.Exists(word) Then wordsDict.Add word, clicks ' Total Clicks Else wordsDict(word) = wordsDict(word) + clicks End If End If Next word Next cell
' Clear existing data in destination sheet destinationSheet.Cells.Clear
' Set header for destination sheet destinationSheet.Cells(1, 1).Value = "Word" destinationSheet.Cells(1, 2).Value = "Total Clicks"
' Loop through dictionary and paste results to destination sheet Dim rowIndex As Long rowIndex = 2
For Each word In wordsDict.keys Dim totalClicks As Double totalClicks = wordsDict(word)
' Paste word and total clicks in destination sheet destinationSheet.Cells(rowIndex, 1).Value = word destinationSheet.Cells(rowIndex, 2).Value = totalClicks
rowIndex = rowIndex + 1 Next word End Sub
[/vba] Пару слов о том как он работает: он проходится по списку словосочетаний со статистикой и берет оттуда уникальные слова и вытягивает также то, как часто кликают на словосочетания, которые включают определенное слово. Проблема в том, что он находит приблизительное количество кликов по словосочетаниям. С высоты вашего опыта, подскажите пожалуйста, что может быть не так в макросе или таблице, что приводит к неправильному подсчету? С Файлом проблема, не могу его закинуть. Единственное что я пока что опробовал изменить - это формат ячеек с общего на числовой. Больше идей нет
Здравствуйте друзья, у меня вопрос теоретический скорее, так как не могу скинуть рабочий файл по некоторым причинам. Вот мой макрос который я юзаю для подсчет уникальных слов в списке слов на другом листе: [vba]
Код
Sub StatisticForEachWord() Dim sourceSheet As Worksheet Dim destinationSheet As Worksheet Dim lastRow As Long Dim sourceRange As Range Dim cell As Range Dim wordsDict As Object Dim wordCombination As String Dim clicks As Double
' Set the source and destination sheets Set sourceSheet = ThisWorkbook.Sheets("Sheet1") ' Change to your source sheet name Set destinationSheet = ThisWorkbook.Sheets("Sheet2") ' Change to your destination sheet name
' Find the last row in column I lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "I").End(xlUp).Row
' Set the source range Set sourceRange = sourceSheet.Range("I2:K" & lastRow) ' Assuming data starts from row 2
' Create a dictionary to store words and their statistics Set wordsDict = CreateObject("Scripting.Dictionary")
' Loop through each cell in the source range For Each cell In sourceRange.Rows wordCombination = cell.Cells(1, 1).Value clicks = cell.Cells(1, 3).Value ' Assuming clicks are in column K
' Split word combination into individual words Dim words() As String words = Split(wordCombination, " ")
' Create a dictionary to track unique words in this cell Dim cellWordsDict As Object Set cellWordsDict = CreateObject("Scripting.Dictionary")
For Each word In words word = Trim(word) If Not cellWordsDict.Exists(word) Then cellWordsDict.Add word, True If Not wordsDict.Exists(word) Then wordsDict.Add word, clicks ' Total Clicks Else wordsDict(word) = wordsDict(word) + clicks End If End If Next word Next cell
' Clear existing data in destination sheet destinationSheet.Cells.Clear
' Set header for destination sheet destinationSheet.Cells(1, 1).Value = "Word" destinationSheet.Cells(1, 2).Value = "Total Clicks"
' Loop through dictionary and paste results to destination sheet Dim rowIndex As Long rowIndex = 2
For Each word In wordsDict.keys Dim totalClicks As Double totalClicks = wordsDict(word)
' Paste word and total clicks in destination sheet destinationSheet.Cells(rowIndex, 1).Value = word destinationSheet.Cells(rowIndex, 2).Value = totalClicks
rowIndex = rowIndex + 1 Next word End Sub
[/vba] Пару слов о том как он работает: он проходится по списку словосочетаний со статистикой и берет оттуда уникальные слова и вытягивает также то, как часто кликают на словосочетания, которые включают определенное слово. Проблема в том, что он находит приблизительное количество кликов по словосочетаниям. С высоты вашего опыта, подскажите пожалуйста, что может быть не так в макросе или таблице, что приводит к неправильному подсчету? С Файлом проблема, не могу его закинуть. Единственное что я пока что опробовал изменить - это формат ячеек с общего на числовой. Больше идей нет mishura08
Сообщение отредактировал mishura08 - Пятница, 25.08.2023, 14:47