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

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

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

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

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

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

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

В общем..... ужасная идея

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

  1. Не создавайте переменные
  2. Если в необработанном листе данных найдено состояние, просмотрите выходной лист, чтобы проверить, было ли это состояние найдено ранее.
  3. Если состояние было найдено ранее, увеличить ячейку рядом с одним
  4. Если состояние не было найдено ранее, измените следующую доступную пустую ячейку на инициалы состояния и инициализируйте ячейку рядом с единицей
  5. Вернуться к необработанным данным

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

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

Спасибо,

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

Источник

4 ответа

Решение

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

  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

  1. Цикл по клеткам очень медленный. Намного быстрее сначала скопировать данные в вариантный массив, а затем перебрать массив. Кроме того, при создании большого количества данных на листе лучше сначала создать его в массиве вариантов, а затем скопировать его на лист за один раз.

    DIM v As Variant
v = rng

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

Источник 
   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
Источник

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

Код:

' 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 (грубое предположение). Я думаю, что единственный способ заставить код работать быстрее - как-то иметь возможность не активировать две книги снова и снова. Это означает, что ответ не полный, но я отредактирую, если выясню остальное.

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

Спасибо,

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

Источник

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

Код:

' 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

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

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

Источник
Другие вопросы по тегам