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 行的值，因此我可以將其存儲在一個變量中，我將使用該變量來計算該組件在一周內出現的次數。 我認為它應該像這樣 Component = 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

我建議看看 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

Answer 2

我會嘗試一下。 我不是 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 3

下面的代碼是你自己的代碼，部分是我評論的，並且是我自己為那些你似乎迷路的部分制作的。

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 列將包含一個周數，並且這個周數也可以在組件數據中找到（在 B 列中）。 如果是這樣，您將按周計算每個組件的出現次數，這就是我編寫的程序。

我認為那部分錯了也沒關系。 您的主要問題是如何在Calculations!D1:??查找每個組件。 . 這種方法在我上面的回答中得到了很好的展示，我相信你將能夠將有用的部分移植到你自己的項目中。 祝你好運！