Excel L oop Через все заполненные ячейки в строке 1

Question

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

я создал код, который получает отдельные имена компонентов из таблицы компонентов, а затем копирует и переносит их на лист калькулятора. все имена компонентов находятся в строке 1, начиная со столбца D1, затем переходят в E1, F1 и т. д. я хочу, чтобы в строке 2 отображалось количество или количество раз, которое компонент (указанный в строке 1) появлялся за неделю.

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

'// здесь код, который я использовал для транспонирования отдельных компонентов с листа компонентов на лист калькулятора

Public Sub GetDistinctComponents()
Application.ScreenUpdating = False

Dim lr As Long
    lr = Sheets("Components Data").Cells(Rows.Count, "F").End(xlUp).Row
    Sheets("Calculator").Unprotect Password:="secret"
    Sheets("Components Data").Range("F1:F" & lr).AdvancedFilter Action:=xlFilterCopy, _
    CopyToRange:=ActiveSheet.Range("DW1"), Unique:=True

    With ThisWorkbook.Worksheets("Calculator")
    .Range(.Range("DW1"), .Range("DW1").End(xlDown)).Copy
    .Range("DX1").PasteSpecial xlPasteValues, Transpose:=True
    .Columns("DW").EntireColumn.Delete
End With
Sheets("Calculator").Protect Password:="secret", DrawingObjects:=False
End Sub

Вот мой лист компонентов

А ниже мой лист калькулятора. как видите, код для транспонирования отдельных компонентов работает нормально. я просто не знаю, как получить значение строки 1, начиная с DX, чтобы я мог сохранить его в переменной, которую я буду использовать при подсчете количества раз, которое компонент появлялся за неделю. Я думаю, это должно go как этот Component = wsCalculator.Cells (i, "D"). Значение Но этот код работает, только если я хочу получить значения всех ячеек в столбце D, а не значения ячеек рядом с D1

и вот код, который у меня сейчас есть

Public Sub CountComponent()
Application.ScreenUpdating = False
Sheets("Calculator").Unprotect Password:="secret"
Set wsComponentData = Sheets("Components Data")
Set wsCalculator = Sheets("Calculator")
Dim ComponentCount As Integer

'//Get the index of the last filled row based on column A
LastComponentRowIndex = wsComponentData.Cells(Rows.Count, "A").End(xlUp).Row

'//Get Range for ComponentData
Set ComponentRange = wsComponentData.Range("F2:F" & LastComponentRowIndex)

'//Get the index of the last filled row based on column C
LasttotalauditRowIndex = wsCalculator.Cells(Rows.Count, "C").End(xlUp).Row

'//Get range for Calculator
Set MyRange = wsCalculator.Range("C2:C" & LasttotalauditRowIndex)
TotalCalls = WorksheetFunction.Sum(MyRange)

'//Looping through all filled rows in the Components Data sheet
For i = 2 To wsCalculator.Cells(Rows.Count, "A").End(xlUp).Row

'//Get Component from cell in column "DW"
    'Component = wsCalculator.Cells(i, "DW").Value

    '//Count the # of calls that got hit in the corresponding Component
    If wsCalculator.Cells(i, "DW").Value <> "" Then
    ComponentCount = Application.WorksheetFunction.CountIf( _
    ComponentRange, component)
    wsCalculator.Cells(i, "DX").Value = ComponentCount
    End If
Next
End Sub

Answer 1

Я возьму трещину в этом. Я не уверен на 100%, что вы делаете, но я предполагаю, что у вас скоро будут вычисления в ячейках D2, внизу и справа. Это верно? Попробуйте этот небольшой пример кода, чтобы скопировать его из D2 (внизу и справа) на листе «Данные компонентов» и перенести на лист «Калькулятор».

Sub TransposeThis()

Set Rng = Sheets("Components Data").Range("D2:D7")   'Input range of all fruits
Set Rng_output = Sheets("Calculator").Range("B2")   'Output range

For i = 1 To Rng.Cells.Count
    Set rng_values = Range(Rng.Cells(i).Offset(0, 1), Rng.Cells(i).End(xlToRight)) 'For each fruit taking the values to the right which need to be transposed

    If rng_values.Cells.Count < 16000 Then 'To ensure that it doesnt select till the right end of the sheet
        For j = 1 To rng_values.Cells.Count
                Rng_output.Value = Rng.Cells(i).Value
                Rng_output.Offset(0, 1).Value = rng_values.Cells(j).Value
                Set Rng_output = Rng_output.Offset(1, 0)  'Shifting the output row so that next value can be printed
        Next j
    End If
Next i

End Sub

До:

После:

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

Answer 2

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

Public Sub CountComponent()

    ' Locations:-
    Dim WsComp As Worksheet
    Dim WsCalc As Worksheet
    Dim CompRng As Range                    ' column A
    Dim CalcRng As Range                    ' Calculator!D1:D?)
    Dim Rt As Long                          ' Target row (in WsCalc)
    ' Helpers:-
    Dim Cell As Range
    Dim R As Long

    Set WsComp = Sheets("Components Data")
    Set WsCalc = Sheets("Calculator")
    WsCalc.Unprotect Password:="secret"

    Application.ScreenUpdating = False
    '//Get the index of the last filled row based on column A
    With WsComp
        ' observe the leading period in ".Rows.Count"
        'LastComponentRowIndex = .Cells(.Rows.Count, "A").End(xlUp).Row

        '//Get Range for ComponentData
        'Set CompRng = .Range("A2:A" & LastComponentRowIndex)
        ' avoids the need for decalring LastComponentRowIndex
        Set CompRng = .Range(.Cells(2, "A"), _
                             .Cells(.Rows.Count, "A").End(xlUp))
    End With

    With WsCalc
        ' set a range of all criteria to look up
        Set CalcRng = .Range(.Cells(1, "D"), _
                             .Cells(1, .Columns.Count).End(xlToLeft))

        '//Get the index of the last non-empty row in column B
        ' loop through all rows in WsCalc
        For R = .Cells(.Rows.Count, "B").End(xlUp).Row To 2 Step -1
            If Val(.Cells(R, "B").Value) Then           ' presumed to be a week number
                '//Loop through all audit criteria
                For Each Cell In CalcRng
                    With .Cells(R, Cell.Column)
                        .Value = WorksheetFunction.CountIfs( _
                                                   CompRng, Cell.Value, _
                                                   CompRng.Offset(0, 1), WsCalc.Cells(R, "B").Value)
                        .NumberFormat = "0;-0;;"        ' suppress display of zero
                    End With
                Next Cell
            End If
            .Cells(R, "C").Value = WorksheetFunction.Sum(CalcRng.Offset(R - 1))
        Next R
    End With
    Application.ScreenUpdating = True
End Sub

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

Я думаю, это не имеет значения, если я неправильно понял эту часть. Ваш главный вопрос заключался в том, как найти каждый из компонентов в Calculations!D1:??. Этот метод очень хорошо продемонстрирован в моем ответе выше, и я уверен, что вы сможете перенести полезные элементы в свой собственный проект. Удачи!

Answer 3

Предлагаю взглянуть на словари VBA. В этом случае вы можете сохранить каждый компонент в качестве ключа, а для значения можно накапливать количество вхождений компонента за данную неделю.

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

Для довольно полного обзора словарей в VBA, вот хороший ресурс, который ' d Я бы порекомендовал: https://excelmacromastery.com/vba-dictionary/

Public Sub CountComponent()
Application.ScreenUpdating = False
Sheets("Calculator").Unprotect Password:="secret"
Set wsComponentData = Sheets("Components Data")
Set wsCalculator = Sheets("Calculator")

'//Get the index of the last filled row based on column A
LastComponentRowIndex = wsComponentData.Cells(Rows.Count, "A").End(xlUp).Row

'//Get Range for ComponentData
Set ComponentRange = wsComponentData.Range("A2:A" & LastComponentRowIndex)

'//Get the index of the last filled row based on column C
LasttotalauditRowIndex = wsCalculator.Cells(Rows.Count, "C").End(xlUp).Row

'//Get range for Calculator
Set MyRange = wsCalculator.Range("C2:C" & LasttotalauditRowIndex)
TotalCalls = WorksheetFunction.Sum(MyRange)

'// Declare a new dictionary
dim componentDict as New Scripting.Dictionary

'// First loop through the Calculator sheet to get each component 
'// and set initial value to zero
dim i as Long, lastCalcColumn as Long
lastCalcColumn = wsCalculator.Cells(1, Columns.count).end(xlToLeft).Column

for i = 4 to lastCalcColumn
    '// Adding each item to dictionary, a couple of ways to write this,
    '// but this is probably the easiest
    componentDict(wsCalculator.Cells(i, 1).Value) = 0
next i

'//Looping through all filled rows in the Components Data sheet
'// I changed this to loop through each row in your component sheet
'// So that we can accumulate the total occurences
dim current_key as String

For i = 2 To LastComponentRowIndex
    If wsComponentData.Range("G" & i).Value <> "" Then
        '// assuming component names are in the "G" column
        '// change this as needed
        current_key = wsComponentData.Range("G" & i).Value
        componentDict(current_key) = componentDict(current_key) + 1  
    end if
Next i

'// now back to the Calculator sheet to enter the values
for i = 4 to lastCalcColumn
    current_key = wsCalculator.Cells(i, 1).Value
    wsCalculator.Cells(i, 2).Value = componentDict(current_key)
next i

End Sub