Excel循环遍历第1行中的所有填充单元格

Question

我确定这是可能的，我只是不确定代码应该是什么。我有 2 张工作表：（1）组件，其中包含分析师标记的所有组件名称，包括调用发生的日期，以及（2）计算器，它计算特定组件在特定组件中出现的次数周数。

我创建了一个代码，该代码从组件表中获取不同的组件名称，然后将它们复制并转置到计算器表中。所有组件名称都在第 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

这是我的组件表

下面是我的计算器表。如您所见，转置不同组件的代码工作正常。我只是不知道如何从 DX 开始获取第 1 行的值，因此我可以将其存储在一个变量中，我将使用该变量来计算该组件在一周内出现的次数。我想它应该是这样的 组件 = wsCalculator.Cells(i, "D").Value 但是这个代码只有在我想获取 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

坦率地说，我无法理解您的所有意图。我假设您的 Calculations 表中的 B 列将包含周数，并且该周数也将在 Components Data 中找到（在 B 列中）。如果是这样，您将按周计算每个组件的出现次数，这就是我编写的程序。

我认为如果我把那部分弄错了也没关系。您的主要问题是如何在Calculations!D1:?? 中查找每个组件。该方法在我的上述答案中得到了很好的证明，我相信您将能够将有用的部分移植到您自己的项目中。祝你好运！

Answer 3

我建议看一下 VBA 词典。在这种情况下，您可以将每个组件存储为一个键，对于值，您可以累积该组件在给定周内的出现次数。

目前我的计算机上没有可用的 VBA 编辑器来测试它，但它可能看起来与我下面的内容类似。另外，我承认我可能没有完全理解你的表格布局，但这里的一般原则肯定适用。

如需全面了解 VBA 中的字典，我推荐以下资源：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