Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Что в теории может влиять на неверный подсчет макросом? - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Что в теории может влиять на неверный подсчет макросом?
mishura08 Дата: Пятница, 25.08.2023, 14:46 | Сообщение № 1
Группа: Проверенные
Ранг: Участник
Сообщений: 65
Репутация: 0 ±
Замечаний: 40% ±

2021
Здравствуйте друзья, у меня вопрос теоретический скорее, так как не могу скинуть рабочий файл по некоторым причинам.
Вот мой макрос который я юзаю для подсчет уникальных слов в списке слов на другом листе:
[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 - Пятница, 25.08.2023, 14:47
 
Ответить
СообщениеЗдравствуйте друзья, у меня вопрос теоретический скорее, так как не могу скинуть рабочий файл по некоторым причинам.
Вот мой макрос который я юзаю для подсчет уникальных слов в списке слов на другом листе:
[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
Дата добавления - 25.08.2023 в 14:46
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!