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

Question

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

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

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

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

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

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

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

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

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

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

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

Спасибо,

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

Answer 1

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

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 минут будутне более секунд

Answer 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

Answer 3

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

Код:

' 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

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

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

Answer 4

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

Код:

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

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

Спасибо,

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