VBA Excel, заполняющий ячейки на основе предыдущего существования

ProgramBox

VBA Excel, заполняющий ячейки на основе предыдущего существования

Post author:admin
Запись опубликована:7 мая, 2023
Post category:Вопросы по программированию

#excel #states #vba

#excel #состояния #vba

Вопрос:

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

Учитывая столбец, который содержит инициалы состояния, проверьте выходной лист, было ли это состояние найдено ранее. Если этого не произошло, то заполните новую ячейку инициалами этого состояния и инициализируйте счетчик (количество раз, когда состояние было найдено) до единицы. Если инициалы состояния найдены в ячейке на выходном листе, увеличьте количество на единицу.

С помощью этого, если у нас есть 50 000 (или сколько угодно) листов Excel с разделением, на которых состояния расположены в случайном порядке (состояния могут повторяться, а могут и не повторяться), мы сможем создать чистую таблицу, которая выводит, какие состояния указаны в таблице необработанных данных и сколько раз они появлялись. Другой способ подумать об этом — создать сводную таблицу, но с меньшим количеством информации.

Есть пара способов, о которых я думал, как это сделать, я лично думаю, что ни одна из этих идей не очень хорошая, но посмотрим.

Алгоритм 1, все 50 состояний:

Создайте 50 строковых переменных для каждого состояния, создайте 50 длинных переменных для подсчетов
Выполните цикл по таблице необработанных данных, если найдено конкретное состояние, затем увеличьте соответствующее количество (для этого потребуется 50 операторов if-else)
Выходные результаты

В целом ….. ужасная идея

Алгоритм 2, триггер:

Не создавайте никаких переменных
Если состояние найдено в таблице необработанных данных, загляните в таблицу выходных данных, чтобы проверить, было ли состояние найдено ранее
Если состояние было найдено ранее, увеличьте соседнюю ячейку на единицу
Если состояние не было найдено ранее, измените следующую доступную пустую ячейку на инициалы состояния и инициализируйте ячейку, соседнюю с одной
Вернитесь к таблице исходных данных

В целом ….. это могло бы сработать, но я чувствую, что это займет вечность, даже с не очень большими исходными таблицами данных, но преимущество заключается в том, что не тратится память, как в алгоритме 50 состояний, и меньше строк кода

Кстати, можно ли получить доступ к ячейкам рабочей книги (или листа) без активации этой книги? Я спрашиваю, потому что это заставило бы второй алгоритм работать намного быстрее.

Спасибо,

Джесси Смотермон

1. Разрешено ли вам сортировать данные?

2. Я собираюсь сказать «нет», я не думаю, что это слишком важно (на данный момент) сортировать это

3. Сводная таблица, похоже, решает вашу проблему простым способом. Почему вы не хотите пойти на это?

4. @belisarius в основном для того, чтобы я мог следовать макету, который хочет мой босс. Я собирался сказать, что сводные таблицы содержат больше информации, которая мне действительно нужна (общий итог), но потом я узнал, что вы можете удалить это и добавить границы и тому подобное. Я думаю, в конце концов, это станет файлом PDF, и мы хотим также придать ему эстетическую привлекательность (я еще немного поработаю с ним, но прямо сейчас названия доставляют мне хлопоты). Спасибо за комментарий, я рассмотрю сводные таблицы более внимательно

5. @belisarius на самом деле в сводной таблице у них есть предопределенное название под названием «Метки строк». В идеале мне нужно было бы изменить это на «Состояние» в соответствии с образцами, которые мне были предоставлены (они предназначены для клиентов, поэтому они должны быть относительно понятными). Из-за этого я думаю, что сводные таблицы могут быть не разрешены для конечного продукта

Ответ №1:

Пара моментов, которые ускорят ваш код:

Вам не нужно активировать книги, листы или диапазоны для доступа к ним, например

 DIM wb as workbook  
DIM ws as worksheet  
DIM rng as range

Set wb = Workbooks.OpenText(Filename:=filePath, Tab:=True) ' or Workbooks("BookName")  
Set ws = wb.Sheets("SheetName")  
Set rng = ws.UsedRange ' or ws.[A1:B2], or many other ways of specifying a range

Теперь вы можете ссылаться на рабочую книгу / лист / диапазон следующим образом

 rng.copy
for each  cl in rng.cells
etc

Перебор ячеек происходит очень медленно. Намного быстрее сначала скопировать данные в массив вариантов, а затем выполнить цикл по массиву. Кроме того, при создании большого объема данных на листе лучше сначала создать их в виде массива вариантов, а затем скопировать на лист за один раз.
```
 DIM v As Variant
v = rng
  
```

например, если rng ссылается на диапазон 10 строк по 5 столбцам, v становится массивом dim от 1 до 10, от 1 до 5. Упомянутые вами 5 минут, вероятно, будут сокращены максимум до секунд

Ответ №2:

    Sub CountStates()
     Dim shtRaw As Excel.Worksheet
     Dim r As Long, nr As Long
     Dim dict As Object
     Dim vals, t, k

    Set dict = CreateObject("scripting.dictionary")
    Set shtRaw = ThisWorkbook.Sheets("Raw")
    vals = Range(shtRaw.Range("C2"), _
                 shtRaw.Cells(shtRaw.Rows.Count, "C").End(xlUp)).Value
    nr = UBound(vals, 1)

    For r = 1 To nr
        t = Trim(vals(r, 1))
        If Len(t) = 0 Then t = "Empty"
        dict(t) = dict(t)   1
    Next r

    For Each k In dict.keys
        Debug.Print k, dict(k)
    Next k
End Sub

Ответ №3:

Я реализовал свой второй алгоритм, чтобы посмотреть, как это будет работать. Код приведен ниже, я опустил небольшие детали в реальной проблеме, чтобы попытаться быть более ясным и добраться до основной проблемы, извините за это. С помощью приведенного ниже кода я добавил другие «части».

Код:

 ' this number refers to the raw data sheet that has just been activated
totalRow = ActiveSheet.Range("A1").End(xlDown).Row
    For iRow = 2 To totalRow
        ' These are specific to the company needs, refers to addresses
        If (ActiveSheet.Cells(iRow, 2) = "BA") Then
            badAddress = badAddress   1
        ElseIf (ActiveSheet.Cells(iRow, 2) = "C") Then
            coverageNoListing = coverageNoListing   1
        ElseIf (ActiveSheet.Cells(iRow, 2) = "L") Then
            activeListing = activeListing   1
        ElseIf (ActiveSheet.Cells(iRow, 2) = "NC") Then
            noCoverageNoListing = noCoverageNoListing   1
        ElseIf (ActiveSheet.Cells(iRow, 2) = "NL") Then
            inactiveListing = inactiveListing   1
        ElseIf (ActiveSheet.Cells(iRow, 2) = "") Then
            noHit = noHit   1
        End If
        ' Algorithm beginning
        ' If the current cell (in state column) has something in it
        If (ActiveSheet.Cells(iRow, 10) <> "") Then
            ' Save value into a string variable
            tempState = ActiveSheet.Cells(iRow, 10)
            ' If this is also in a billable address make variable true
            If (ActiveSheet.Cells(iRow, 2) = "C") Or (ActiveSheet.Cells(iRow, 2) = "L") Or (ActiveSheet.Cells(iRow, 2) = "NL") Then
                boolStateBillable = True
            End If
            ' Output sheet
            BillableWorkbook.Activate
            For tRow = 2 To endOfState
                ' If the current cell is the state
                If (ActiveSheet.Cells(tRow, 9) = tempState) Then
                    ' Get the current hit count of that state
                    tempStateTotal = ActiveSheet.Cells(tRow, 12)
                    ' Increment the hit count by one
                    ActiveSheet.Cells(tRow, 12) = tempStateTotal   1
                    ' If the address was billable then increment billable count
                    If (boolStateBillable = True) Then
                        tempStateBillable = ActiveSheet.Cells(tRow, 11)
                        ActiveSheet.Cells(tRow, 11) = tempStateBillable   1
                    End If
                    Exit For
                ' If the tempState is unique to the column
                ElseIf (tRow = endOfState) Then
                    ' Set state, totalCount
                    ActiveSheet.Cells(tRow - 1, 9) = tempState
                    ActiveSheet.Cells(tRow - 1, 12) = 1
                    ' Increment the ending point of the column
                    endOfState = endOfState   1
                    ' If it's billable, indicate with number
                    If (boolStateBillable = True) Then
                        tempStateBillable = ActiveSheet.Cells(tRow - 1, 11)
                        ActiveSheet.Cells(tRow - 1, 11) = tempStateBillable   1
                    End If
                End If
            Next
        ' Activate raw data workbook
        TextFileWorkbook.Activate
        ' reset boolean
        boolStateBillable = False
    Next

Я запустил его один раз, и, похоже, это сработало. Проблема в том, что это заняло примерно пять минут или около того, исходный код занимает 0.2 (приблизительное предположение). Я думаю, что единственный способ ускорить выполнение кода — это каким-то образом иметь возможность не активировать две книги снова и снова. Это означает, что ответ неполный, но я отредактирую, если выясню остальное.

Примечание Я вернусь к сводным таблицам, чтобы посмотреть, смогу ли я сделать в них все, что мне нужно, на данный момент, похоже, есть пара вещей, которые я не смогу изменить, но я проверю

Спасибо,

Джесси Смотермон

Ответ №4:

Я придерживался второго алгоритма. Есть опция словаря, которую я забыл, но мне все еще не очень комфортно с тем, как это работает, и я, как правило, еще не совсем понимаю это. Я немного поиграл с кодом и кое-что изменил, теперь он работает быстрее.

Код:

 ' In output workbook (separate sheet)
Sheets.Add.Name = "Temp_Text_File"

' Opens up raw data workbook (originally text file
Application.DisplayAlerts = False
Workbooks.OpenText Filename:=filePath, Tab:=True
Application.DisplayAlerts = True
Set TextFileWorkbook = ActiveWorkbook
totalRow = ActiveSheet.Range("A1").End(xlDown).Row
' Copy all contents of raw data workbook
Cells.Select
Selection.Copy

BillableWorkbook.Activate

' Paste raw data into "Temp_Text_File" sheet
Range("A1").Select
ActiveSheet.Paste

ActiveWorkbook.Sheets("Billable_PDF").Select

' Populate long variables
For iRow = 2 To totalRow
    If (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "BA") Then
        badAddress = badAddress   1
    ElseIf (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "C") Then
        coverageNoListing = coverageNoListing   1
    ElseIf (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "L") Then
        activeListing = activeListing   1
    ElseIf (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "NC") Then
        noCoverageNoListing = noCoverageNoListing   1
    ElseIf (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "NL") Then
        inactiveListing = inactiveListing   1
    ElseIf (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "") Then
        noHit = noHit   1
    End If
    If (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 10) <> "") Then
        tempState = ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 10)
        If (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "C") Or (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "L") Or (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "NL") Then
            boolStateBillable = True
        End If
        'BillableWorkbook.Activate
        For tRow = 2 To endOfState
            If (ActiveSheet.Cells(tRow, 9) = tempState) Then
                tempStateTotal = ActiveSheet.Cells(tRow, 12)
                ActiveSheet.Cells(tRow, 12) = tempStateTotal   1
                If (boolStateBillable = True) Then
                    tempStateBillable = ActiveSheet.Cells(tRow, 11)
                    ActiveSheet.Cells(tRow, 11) = tempStateBillable   1
                End If
                Exit For
            ElseIf (tRow = endOfState) Then
                ActiveSheet.Cells(tRow, 9) = tempState
                ActiveSheet.Cells(tRow, 12) = 1
                endOfState = endOfState   1
                If (boolStateBillable = True) Then
                    tempStateBillable = ActiveSheet.Cells(tRow, 11)
                    ActiveSheet.Cells(tRow, 11) = tempStateBillable   1
                End If
            End If
        Next
        'stateOneTotal = stateOneTotal   1
        'If (ActiveSheet.Cells(iRow, 2) = "C") Or (ActiveSheet.Cells(iRow, 2) = "L") Or (ActiveSheet.Cells(iRow, 2) = "NL") Then
        '    stateOneBillable = stateOneBillable   1
        'End If
    'ElseIf (ActiveSheet.Cells(iRow, 10) = "FL") Then
        'stateTwoTotal = stateTwoTotal   1
        'If (ActiveSheet.Cells(iRow, 2) = "C") Or (ActiveSheet.Cells(iRow, 2) = "L") Or (ActiveSheet.Cells(iRow, 2) = "NL") Then
        '    stateTwoBillable = stateTwoBillable   1
        'End If
    End If
    'TextFileWorkbook.Activate
    If (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "C") Or (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "L") Or (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "NL") Then
        billableCount = billableCount   1
    End If
    boolStateBillable = False
Next

' Close raw data workbook and raw data worksheet
Application.DisplayAlerts = False
TextFileWorkbook.Close
ActiveWorkbook.Sheets("Temp_Text_File").Delete
Application.DisplayAlerts = True

Спасибо за комментарии и предложения. Это, как всегда, очень ценится.

Джесси Смотермон

Вопрос:

Комментарии:

Ответ №1:

Ответ №2:

Ответ №3:

Ответ №4:

Вам также может понравиться

PhpSpreadsheet | сохранение XLSX отображает каждую строку

Маршруты в Codeigniter — автоматически

Проблема с преобразованием из java.util.Дата в java.sql.Timestamp