none
Formula para linhas RRS feed

  • Pergunta

  • Boa tarde,

    Estou a analisar dados entre duas tabelas X e Y, sendo que os 9 primeiros números de cada celula nesta tabela pertencem a X.

    O que eu pretendo é que para cada elemento da minha tabela A, procurar o valores de Y e colocar na respectiva linha.

    Em coluna eu fazia através de um procv, mas em linha não estou a conseguir fazer..

    Qualquer ajuda é bem vinda

    Obrigado a todos.


    Nuno Silva


    • Editado NunoM Silva quarta-feira, 21 de outubro de 2015 16:21
    quarta-feira, 21 de outubro de 2015 16:20

Respostas

  • Sub Main()
        Const DEFAULT_COLUMN As String = "A"
        Const OUTPUT_WORKSHEET_NAME As String = "PlanA"
        
        Dim wsA As Worksheet
        Dim wsX As Worksheet
        Dim wsY As Worksheet
        Dim cUniqueValues As Collection
        Dim i As Long
        Dim iRowA As Long
        Dim iRowY As Long
        Dim iValue As String
        
        'Configura planilhas
        With ThisWorkbook
            Application.DisplayAlerts = False
            On Error Resume Next
            .Worksheets(OUTPUT_WORKSHEET_NAME).Delete
            On Error GoTo 0
            Application.DisplayAlerts = True
            Set wsA = .Worksheets.Add(After:=.Sheets(.Sheets.Count))
            wsA.Name = OUTPUT_WORKSHEET_NAME
            Set wsX = .Worksheets("PlanX")
            Set wsY = .Worksheets("PlanY")
        End With
        
        'Descobre itens únicos de PlanX
        Set cUniqueValues = New Collection
        On Error Resume Next
        With wsX
            For i = 1 To GetLastRowIndex(.Columns(DEFAULT_COLUMN))
                iValue = CStr(.Cells(i, DEFAULT_COLUMN).Value)
                cUniqueValues.Add iValue, iValue
            Next i
        End With
    
        'Povoa PlanA
        wsA.Columns(DEFAULT_COLUMN).NumberFormat = "@"
        For i = 1 To cUniqueValues.Count
            wsA.Cells(i, DEFAULT_COLUMN).Value = CStr(cUniqueValues(i))
        Next i
        
        'Busca correspondências em PlanY
        For iRowY = 1 To GetLastRowIndex(wsY.Columns(DEFAULT_COLUMN))
            iValue = wsY.Cells(iRowY, DEFAULT_COLUMN).Value
            iRowA = WorksheetFunction.Match(Split(iValue, "-")(0), wsA.Columns(DEFAULT_COLUMN), 0)
            wsA.Cells(iRowA, GetLastColumnIndex(wsA.Rows(iRowA)) + 1).Value = iValue
        Next iRowY
    End Sub
    
    Private Function GetLastRowIndex(pColumn As Range) As Long
        Dim wsParent As Worksheet
        
        Set wsParent = pColumn.Worksheet
        With wsParent
            GetLastRowIndex = .Cells(.Rows.Count, pColumn.Column).End(xlUp).Row
        End With
    End Function
    
    Private Function GetLastColumnIndex(pRow As Range) As Long
        Dim wsParent As Worksheet
        
        Set wsParent = pRow.Worksheet
        With wsParent
            GetLastColumnIndex = .Cells(pRow.Row, .Columns.Count).End(xlToLeft).Column
        End With
    End Function


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 22 de outubro de 2015 18:14
    Moderador

Todas as Respostas

  • Experimente utilizar a função PROCH.

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br


    quinta-feira, 22 de outubro de 2015 13:31
    Moderador
  • Obrigado.

    Mas o =PROCH apenas vai procurar valor na horizontal. E alem disso preciso que de procurar os 9 primeiros dígitos na tabela Y


    Nuno Silva

    quinta-feira, 22 de outubro de 2015 16:55
  • Sub Main()
        Const DEFAULT_COLUMN As String = "A"
        Const OUTPUT_WORKSHEET_NAME As String = "PlanA"
        
        Dim wsA As Worksheet
        Dim wsX As Worksheet
        Dim wsY As Worksheet
        Dim cUniqueValues As Collection
        Dim i As Long
        Dim iRowA As Long
        Dim iRowY As Long
        Dim iValue As String
        
        'Configura planilhas
        With ThisWorkbook
            Application.DisplayAlerts = False
            On Error Resume Next
            .Worksheets(OUTPUT_WORKSHEET_NAME).Delete
            On Error GoTo 0
            Application.DisplayAlerts = True
            Set wsA = .Worksheets.Add(After:=.Sheets(.Sheets.Count))
            wsA.Name = OUTPUT_WORKSHEET_NAME
            Set wsX = .Worksheets("PlanX")
            Set wsY = .Worksheets("PlanY")
        End With
        
        'Descobre itens únicos de PlanX
        Set cUniqueValues = New Collection
        On Error Resume Next
        With wsX
            For i = 1 To GetLastRowIndex(.Columns(DEFAULT_COLUMN))
                iValue = CStr(.Cells(i, DEFAULT_COLUMN).Value)
                cUniqueValues.Add iValue, iValue
            Next i
        End With
    
        'Povoa PlanA
        wsA.Columns(DEFAULT_COLUMN).NumberFormat = "@"
        For i = 1 To cUniqueValues.Count
            wsA.Cells(i, DEFAULT_COLUMN).Value = CStr(cUniqueValues(i))
        Next i
        
        'Busca correspondências em PlanY
        For iRowY = 1 To GetLastRowIndex(wsY.Columns(DEFAULT_COLUMN))
            iValue = wsY.Cells(iRowY, DEFAULT_COLUMN).Value
            iRowA = WorksheetFunction.Match(Split(iValue, "-")(0), wsA.Columns(DEFAULT_COLUMN), 0)
            wsA.Cells(iRowA, GetLastColumnIndex(wsA.Rows(iRowA)) + 1).Value = iValue
        Next iRowY
    End Sub
    
    Private Function GetLastRowIndex(pColumn As Range) As Long
        Dim wsParent As Worksheet
        
        Set wsParent = pColumn.Worksheet
        With wsParent
            GetLastRowIndex = .Cells(.Rows.Count, pColumn.Column).End(xlUp).Row
        End With
    End Function
    
    Private Function GetLastColumnIndex(pRow As Range) As Long
        Dim wsParent As Worksheet
        
        Set wsParent = pRow.Worksheet
        With wsParent
            GetLastColumnIndex = .Cells(pRow.Row, .Columns.Count).End(xlToLeft).Column
        End With
    End Function


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 22 de outubro de 2015 18:14
    Moderador