简体   繁体   中英

Excel Loop Through all filled cells in row 1

I'm sure this is possible, im just not sure what the code should be. i have 2 sheets: (1)Component which has all the Component Names where an analyst got marked down on, including dates of when the call occurred, and (2)Calculator, which counts the number of times a specific component appeared in a specific week number.

ive created a code which gets the distinct Component Names from the Component Sheet, and then copies and transpose them to the Calculator sheet. all the Component Names are in Row 1 starting from Column D1 then goes to E1, F1, and so on. i want row 2 to display the count or the number of times the component(listed in row 1) appeared in a week.

The code i have only works for columns, i do not know how to make it get the non-empty values of an entire row.

'//here the code i used to transpose Distinct Components from the Component sheet to the Calculator Sheet

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

Here's my Component sheet组件数据

And below is my Calculator sheet. as you can see, the code to transpose the distinct Components works fine. i just do not know how to get the value of Row 1 starting from DX so i can store it in a variable which i will use in counting the number of times that component appeared in a week . I'm thinking it should go like this Component = wsCalculator.Cells(i, "D").Value But this code only works if i want to get the Values of all cells in Column D, not the values of the cells next to D1

计算器

and here's the code i currently have

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

I suggest taking a look at VBA dictionaries. In this case, you could store each component as a key and for the value you can accumulate the number of occurrences of the component for a given week.

I don't have a VBA editor available on my computer at the moment to test this, but it would likely look something along the lines of what I've got below. Also, I'll admit that I may not have fully understood the layout of your sheets, but the general principle here will definitely apply.

For a pretty full overview of dictionaries in VBA, here's a good resource that'd I'd recommend: 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

I'll take a crack at this. I'm not 100% sure what you are doing, but I'm going to assume you will have soon calculations in cells D2, down, and to the right. Is that correct? Try this small code sample to copy from D2 (down and right) on the "Components Data" sheet, and transpose to your "Calculator" sheet.

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

Before:

在此处输入图片说明

After:

在此处输入图片说明

If I got something wrong, post your feedback, and I'll adjust the code to suit your needs.

The code below is your own code, in part, which I commented, and of my own making for those parts where you seemed to have lost your way.

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

Frankly, I couldn't understand all of your intentions. I presumed that column B in your Calculations sheet would contain a week number and that this week number would also be found in the Components Data (in column B). If so, you would be counting the occurrences of each component by week, and that is what I programmed.

I think it doesn't matter if I got that part wrong. Your main question was how to look up each of the Components in Calculations!D1:?? . That method is very well demonstrated in my above answer and I feel confident you will be able to transplant the useful bits to your own project. Good luck!

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM