A macro do Excel copia as mesmas entradas uma vez em outra folha de papel

Question

Sou muito novo no VBA Excel.

Digamos que eu tenha o paper 1 na coluna A muitos tipos de alerta e a coluna B o local onde isso aconteceu (estou trabalhando para uma empresa de segurança). O que eu preciso fazer é ler a coluna A e depois a coluna B; se houver mais de 50 vezes o mesmo valor da coluna A, coloque-o no papel 2 sem colocá-lo no número de vezes X, somente quando a coluna B for diferente.

Exemplo:

Col A :                                  Col B : 
Alert named 1 (50 times repeated)        Chicago
Alert named 1 (50 times repeated)        Tunis
Alert named 1 (50 times repeated)        Tunis
Alert named 1 (50 times repeated)        Tunis
Alert named 2                            ohoa

No papel 2:

Col A :           Col B :
Alert named 1     Chicago
Alert named 1     Tunis

    

Answer 1

Eu não acho que isso seja possível apenas com uma fórmula. Aqui está uma macro que eu escrevi e testei que listará qualquer Alert Type junto com o Location on Sheet 2 se ocorrer 50 times in a row in Sheet 1 .

Abra VBE ALT + F11 , insira um novo Module 1 e copie e cole o código abaixo.

Sub Main()

    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Sheets(1)
    Set ws2 = Sheets(2)

    ReDim arr(0) As String
    Dim i As Long
    For i = 1 To ws1.Range("A" & Rows.Count).End(xlUp).Row
        arr(i - 1) = ws1.Range("A" & i) & "^" & ws1.Range("B" & i)
        ReDim Preserve arr(UBound(arr) + 1)
    Next i

    RemoveDuplicate arr
    ReDim Preserve arr(UBound(arr) - 1)

    Dim j As Long, cnt As Long: cnt = 0
    For i = LBound(arr) To UBound(arr)
        For j = 1 To ws1.Range("A" & Rows.Count).End(xlUp).Row
            If arr(i) = ws1.Range("A" & j) & "^" & ws1.Range("B" & j) Then cnt = cnt + 1
        Next j
        If cnt > 50 Then
            ws2.Range("A" & ws2.Range("A" & Rows.Count).End(xlUp).Row + 1) = Split(arr(i), "^")(0)
            ws2.Range("B" & ws2.Range("B" & Rows.Count).End(xlUp).Row + 1) = Split(arr(i), "^")(1)
        End If
        cnt = 0
    Next i
    ws2.Columns.AutoFit
End Sub

Private Sub RemoveDuplicate(ByRef StringArray() As String)
    Dim lowBound$, UpBound&, A&, B&, cur&, tempArray() As String
    If (Not StringArray) = True Then Exit Sub
    lowBound = LBound(StringArray): UpBound = UBound(StringArray)
    ReDim tempArray(lowBound To UpBound)
    cur = lowBound: tempArray(cur) = StringArray(lowBound)
    For A = lowBound + 1 To UpBound
        For B = lowBound To cur
            If LenB(tempArray(B)) = LenB(StringArray(A)) Then
                If InStrB(1, StringArray(A), tempArray(B), vbBinaryCompare) = 1 Then Exit For
            End If
        Next B
        If B > cur Then cur = B: tempArray(cur) = StringArray(A)
    Next A
    ReDim Preserve tempArray(lowBound To cur): StringArray = tempArray
End Sub

Pressione F5 ou Run » Run Sub e confira os resultados em Sheet 2