Új hozzászólás Aktív témák

• Delila_1 veterán

  #53376

  #53375 szürke

  2024-10-08 15:29:36

  Új Válasz

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  

  Delila_1

  veterán

  #53375 szürke

  Az utolsó lap neve legyen Összegzés.
  A makró:
  Sub Szamlalas()
    Dim lap As Integer, sor As Integer, CV As Object, WSGy As Worksheet, db As Integer
    
    Set WSGy = Sheets("Összegzés")
    
    For lap = 1 To Worksheets.Count - 1
        Sheets(lap).Activate
        For Each CV In Range("A1").CurrentRegion
            If CV.Value > "" Then
                If Application.WorksheetFunction.CountIf(WSGy.Columns(1), CV.Value) = 0 Then
                    sor = WSGy.Range("A" & Rows.Count).End(xlUp).Row + 1
                    WSGy.Cells(sor, 1) = CV.Value: WSGy.Cells(sor, 2) = 1
                Else
                    sor = Application.Match(CV.Value, WSGy.Columns(1), 0)
                    WSGy.Cells(sor, 2) = WSGy.Cells(sor, 2) + 1
                End If
            End If
        Next
    Next
End Sub

Új hozzászólás Aktív témák