none
Compactar informação RRS feed

  • Pergunta

  • Bom dia!

     

     

    Pessoal preciso da ajuda de vocês da seguinte forma; a planilha anexa tem a seguinte configuração.

    Item

    Descrição

    Distribuidor a

    Distribuidor b

    Distribuidor c

    01

    Pão

    1

     

    1

    02

    Queijo

     

    1

    1

    03

    Presunto

    1

    1

     

     

     

     

     

     

     

    O que eu estou querendo é uma forma de eu compactar estas informações

    Exp Pão = distribuidor A e Distribuidor C

           Queijo = distribuidor b e distribuidor C

    E assim segue para cada item, tentei com a tabela pivot, porém não tenho muita prática com ela e não consegui, tem como ajudar?

     

     

    **O número 1 é referente a distribuidor que vai receber a mercadoria

     

    Grato     

     

    • Movido AndreAlvesLima terça-feira, 24 de maio de 2011 12:05 (De:Onde devo postar minha dúvida?)
    terça-feira, 24 de maio de 2011 07:33

Respostas

  • Retirado do site de Chip Pearson.

    Cole o código abaixo num módulo. Em seguida, na célula F2, digite =StringConcat(", ";SE($C2:$E2=1;$C$1:$E$1;"")) e pressione Ctrl+Shift+Enter.

    Código:

     

    Function StringConcat(Sep As String, ParamArray Args()) As Variant
     ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     ' StringConcat
     ' By Chip Pearson, chip@cpearson.com, www.cpearson.com
     '     www.cpearson.com/Excel/stringconcatenation.aspx
     ' This function concatenates all the elements in the Args array,
     ' delimited by the Sep character, into a single string. This function
     ' can be used in an array formula. There is a VBA imposed limit that
     ' a string in a passed in array (e.g., calling this function from
     ' an array formula in a worksheet cell) must be less than 256 characters.
     ' See the comments at STRING TOO LONG HANDLING for details.
     ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     Dim S As String
     Dim N As Long
     Dim M As Long
     Dim R As Range
     Dim NumDims As Long
     Dim LB As Long
     Dim IsArrayAlloc As Boolean
     
     '''''''''''''''''''''''''''''''''''''''''''
     ' If no parameters were passed in, return
     ' vbNullString.
     '''''''''''''''''''''''''''''''''''''''''''
     If UBound(Args) - LBound(Args) + 1 = 0 Then
      StringConcat = vbNullString
      Exit Function
     End If
     
     For N = LBound(Args) To UBound(Args)
      ''''''''''''''''''''''''''''''''''''''''''''''''
      ' Loop through the Args
      ''''''''''''''''''''''''''''''''''''''''''''''''
      If IsObject(Args(N)) = True Then
       '''''''''''''''''''''''''''''''''''''
       ' OBJECT
       ' If we have an object, ensure it
       ' it a Range. The Range object
       ' is the only type of object we'll
       ' work with. Anything else causes
       ' a #VALUE error.
       ''''''''''''''''''''''''''''''''''''
       If TypeOf Args(N) Is Excel.Range Then
        '''''''''''''''''''''''''''''''''''''''''
        ' If it is a Range, loop through the
        ' cells and create append the elements
        ' to the string S.
        '''''''''''''''''''''''''''''''''''''''''
        For Each R In Args(N).Cells
         If Len(R.Text) > 0 Then
          S = S & R.Text & Sep
         End If
        Next R
       Else
        '''''''''''''''''''''''''''''''''
        ' Unsupported object type. Return
        ' a #VALUE error.
        '''''''''''''''''''''''''''''''''
        StringConcat = CVErr(xlErrValue)
        Exit Function
       End If
      
      ElseIf IsArray(Args(N)) = True Then
       '''''''''''''''''''''''''''''''''''''
       ' ARRAY
       ' If Args(N) is an array, ensure it
       ' is an allocated array.
       '''''''''''''''''''''''''''''''''''''
       IsArrayAlloc = (Not IsError(LBound(Args(N))) And _
        (LBound(Args(N)) <= UBound(Args(N))))
       If IsArrayAlloc = True Then
        ''''''''''''''''''''''''''''''''''''
        ' The array is allocated. Determine
        ' the number of dimensions of the
        ' array.
        '''''''''''''''''''''''''''''''''''''
        NumDims = 1
        On Error Resume Next
        Err.Clear
        NumDims = 1
        Do Until Err.Number <> 0
         LB = LBound(Args(N), NumDims)
         If Err.Number = 0 Then
          NumDims = NumDims + 1
         Else
          NumDims = NumDims - 1
         End If
        Loop
        On Error GoTo 0
        Err.Clear
        ''''''''''''''''''''''''''''''''''
        ' The array must have either
        ' one or two dimensions. Greater
        ' that two caues a #VALUE error.
        ''''''''''''''''''''''''''''''''''
        If NumDims > 2 Then
         StringConcat = CVErr(xlErrValue)
         Exit Function
        End If
        If NumDims = 1 Then
         For M = LBound(Args(N)) To UBound(Args(N))
          If Args(N)(M) <> vbNullString Then
           S = S & Args(N)(M) & Sep
          End If
         Next M
         
        Else
         ''''''''''''''''''''''''''''''''''''''''''''''''
         ' STRING TOO LONG HANDLING
         ' Here, the error handler must be set to either
         ' On Error GoTo ContinueLoop
         ' or
         ' On Error GoTo ErrH
         ' If you use ErrH, then any error, including
         ' a string too long error, will cause the function
         ' to return #VALUE and quit. If you use ContinueLoop,
         ' the problematic value is ignored and not included
         ' in the result, and the result is the concatenation
         ' of all non-error values in the input. This code is
         ' used in the case that an input string is longer than
         ' 255 characters.
         ''''''''''''''''''''''''''''''''''''''''''''''''
         On Error GoTo ContinueLoop
         'On Error GoTo ErrH
         Err.Clear
         For M = LBound(Args(N), 1) To UBound(Args(N), 1)
          If Args(N)(M, 1) <> vbNullString Then
           S = S & Args(N)(M, 1) & Sep
          End If
         Next M
         Err.Clear
         M = LBound(Args(N), 2)
         If Err.Number = 0 Then
          For M = LBound(Args(N), 2) To UBound(Args(N), 2)
           If Args(N)(M, 2) <> vbNullString Then
            S = S & Args(N)(M, 2) & Sep
           End If
          Next M
         End If
         On Error GoTo ErrH:
        End If
       Else
        If Args(N) <> vbNullString Then
         S = S & Args(N) & Sep
        End If
       End If
       Else
       On Error Resume Next
       If Args(N) <> vbNullString Then
        S = S & Args(N) & Sep
       End If
       On Error GoTo 0
      End If
    ContinueLoop:
     Next N
     
     '''''''''''''''''''''''''''''
     ' Remove the trailing Sep
     '''''''''''''''''''''''''''''
     If Len(Sep) > 0 Then
      If Len(S) > 0 Then
       S = Left(S, Len(S) - Len(Sep))
      End If
     End If
     
     StringConcat = S
     '''''''''''''''''''''''''''''
     ' Success. Get out.
     '''''''''''''''''''''''''''''
     Exit Function
    ErrH:
     '''''''''''''''''''''''''''''
     ' Error. Return #VALUE
     '''''''''''''''''''''''''''''
     StringConcat = CVErr(xlErrValue)
    End Function

     


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Editado Felipe Costa GualbertoMVP segunda-feira, 30 de maio de 2011 13:53
    • Marcado como Resposta Diego Piffaretti terça-feira, 7 de junho de 2011 15:30
    • Não Marcado como Resposta rsant quarta-feira, 8 de junho de 2011 02:39
    • Marcado como Resposta rsant sábado, 11 de junho de 2011 09:46
    quarta-feira, 25 de maio de 2011 02:36
  • Escreve na célula F2 a fórmula:

    =StringConcat(", ";SE(C2:E2>0;$C$1:$E$1;""))

    (Fórmula matricial. Pressione Ctrl+Shift+Enter para entrá-la)

    Em seguida, cole em seu módulo o código de Chip Pearson encontrado em:


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Sugerido como Resposta Diego Piffaretti terça-feira, 7 de junho de 2011 15:30
    • Marcado como Resposta rsant sábado, 11 de junho de 2011 09:47
    segunda-feira, 30 de maio de 2011 13:52

Todas as Respostas

  • Prezado(a),
    Estou migrando seu post para o fórum de Office Geral.
    Por favor, das próximas vezes que tiver alguma dúvida relacionada a esse assunto, poste por lá.
    Obrigado pelo apoio.

    André Alves de Lima
    Microsoft MVP - Client App Dev
    Visite o meu site: http://www.andrealveslima.com.br
    Me siga no Twitter: @andrealveslima
    terça-feira, 24 de maio de 2011 12:05
  • rsant,

     

    Não sou nenhum expert em excel, mas neste caso você vai ter trabalho de mais. Tente fazer merge ou join nestas colunas ou tabelas. Segue abaixo um link que poderá te ajudar.

    http://www.digdb.com/excel_add_ins/join_merge_tables_lists/

    Espero ter ajudado e boa sorte.

    • Sugerido como Resposta Diego Piffaretti terça-feira, 7 de junho de 2011 15:30
    terça-feira, 24 de maio de 2011 12:10
  • Retirado do site de Chip Pearson.

    Cole o código abaixo num módulo. Em seguida, na célula F2, digite =StringConcat(", ";SE($C2:$E2=1;$C$1:$E$1;"")) e pressione Ctrl+Shift+Enter.

    Código:

     

    Function StringConcat(Sep As String, ParamArray Args()) As Variant
     ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     ' StringConcat
     ' By Chip Pearson, chip@cpearson.com, www.cpearson.com
     '     www.cpearson.com/Excel/stringconcatenation.aspx
     ' This function concatenates all the elements in the Args array,
     ' delimited by the Sep character, into a single string. This function
     ' can be used in an array formula. There is a VBA imposed limit that
     ' a string in a passed in array (e.g., calling this function from
     ' an array formula in a worksheet cell) must be less than 256 characters.
     ' See the comments at STRING TOO LONG HANDLING for details.
     ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     Dim S As String
     Dim N As Long
     Dim M As Long
     Dim R As Range
     Dim NumDims As Long
     Dim LB As Long
     Dim IsArrayAlloc As Boolean
     
     '''''''''''''''''''''''''''''''''''''''''''
     ' If no parameters were passed in, return
     ' vbNullString.
     '''''''''''''''''''''''''''''''''''''''''''
     If UBound(Args) - LBound(Args) + 1 = 0 Then
      StringConcat = vbNullString
      Exit Function
     End If
     
     For N = LBound(Args) To UBound(Args)
      ''''''''''''''''''''''''''''''''''''''''''''''''
      ' Loop through the Args
      ''''''''''''''''''''''''''''''''''''''''''''''''
      If IsObject(Args(N)) = True Then
       '''''''''''''''''''''''''''''''''''''
       ' OBJECT
       ' If we have an object, ensure it
       ' it a Range. The Range object
       ' is the only type of object we'll
       ' work with. Anything else causes
       ' a #VALUE error.
       ''''''''''''''''''''''''''''''''''''
       If TypeOf Args(N) Is Excel.Range Then
        '''''''''''''''''''''''''''''''''''''''''
        ' If it is a Range, loop through the
        ' cells and create append the elements
        ' to the string S.
        '''''''''''''''''''''''''''''''''''''''''
        For Each R In Args(N).Cells
         If Len(R.Text) > 0 Then
          S = S & R.Text & Sep
         End If
        Next R
       Else
        '''''''''''''''''''''''''''''''''
        ' Unsupported object type. Return
        ' a #VALUE error.
        '''''''''''''''''''''''''''''''''
        StringConcat = CVErr(xlErrValue)
        Exit Function
       End If
      
      ElseIf IsArray(Args(N)) = True Then
       '''''''''''''''''''''''''''''''''''''
       ' ARRAY
       ' If Args(N) is an array, ensure it
       ' is an allocated array.
       '''''''''''''''''''''''''''''''''''''
       IsArrayAlloc = (Not IsError(LBound(Args(N))) And _
        (LBound(Args(N)) <= UBound(Args(N))))
       If IsArrayAlloc = True Then
        ''''''''''''''''''''''''''''''''''''
        ' The array is allocated. Determine
        ' the number of dimensions of the
        ' array.
        '''''''''''''''''''''''''''''''''''''
        NumDims = 1
        On Error Resume Next
        Err.Clear
        NumDims = 1
        Do Until Err.Number <> 0
         LB = LBound(Args(N), NumDims)
         If Err.Number = 0 Then
          NumDims = NumDims + 1
         Else
          NumDims = NumDims - 1
         End If
        Loop
        On Error GoTo 0
        Err.Clear
        ''''''''''''''''''''''''''''''''''
        ' The array must have either
        ' one or two dimensions. Greater
        ' that two caues a #VALUE error.
        ''''''''''''''''''''''''''''''''''
        If NumDims > 2 Then
         StringConcat = CVErr(xlErrValue)
         Exit Function
        End If
        If NumDims = 1 Then
         For M = LBound(Args(N)) To UBound(Args(N))
          If Args(N)(M) <> vbNullString Then
           S = S & Args(N)(M) & Sep
          End If
         Next M
         
        Else
         ''''''''''''''''''''''''''''''''''''''''''''''''
         ' STRING TOO LONG HANDLING
         ' Here, the error handler must be set to either
         ' On Error GoTo ContinueLoop
         ' or
         ' On Error GoTo ErrH
         ' If you use ErrH, then any error, including
         ' a string too long error, will cause the function
         ' to return #VALUE and quit. If you use ContinueLoop,
         ' the problematic value is ignored and not included
         ' in the result, and the result is the concatenation
         ' of all non-error values in the input. This code is
         ' used in the case that an input string is longer than
         ' 255 characters.
         ''''''''''''''''''''''''''''''''''''''''''''''''
         On Error GoTo ContinueLoop
         'On Error GoTo ErrH
         Err.Clear
         For M = LBound(Args(N), 1) To UBound(Args(N), 1)
          If Args(N)(M, 1) <> vbNullString Then
           S = S & Args(N)(M, 1) & Sep
          End If
         Next M
         Err.Clear
         M = LBound(Args(N), 2)
         If Err.Number = 0 Then
          For M = LBound(Args(N), 2) To UBound(Args(N), 2)
           If Args(N)(M, 2) <> vbNullString Then
            S = S & Args(N)(M, 2) & Sep
           End If
          Next M
         End If
         On Error GoTo ErrH:
        End If
       Else
        If Args(N) <> vbNullString Then
         S = S & Args(N) & Sep
        End If
       End If
       Else
       On Error Resume Next
       If Args(N) <> vbNullString Then
        S = S & Args(N) & Sep
       End If
       On Error GoTo 0
      End If
    ContinueLoop:
     Next N
     
     '''''''''''''''''''''''''''''
     ' Remove the trailing Sep
     '''''''''''''''''''''''''''''
     If Len(Sep) > 0 Then
      If Len(S) > 0 Then
       S = Left(S, Len(S) - Len(Sep))
      End If
     End If
     
     StringConcat = S
     '''''''''''''''''''''''''''''
     ' Success. Get out.
     '''''''''''''''''''''''''''''
     Exit Function
    ErrH:
     '''''''''''''''''''''''''''''
     ' Error. Return #VALUE
     '''''''''''''''''''''''''''''
     StringConcat = CVErr(xlErrValue)
    End Function

     


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Editado Felipe Costa GualbertoMVP segunda-feira, 30 de maio de 2011 13:53
    • Marcado como Resposta Diego Piffaretti terça-feira, 7 de junho de 2011 15:30
    • Não Marcado como Resposta rsant quarta-feira, 8 de junho de 2011 02:39
    • Marcado como Resposta rsant sábado, 11 de junho de 2011 09:46
    quarta-feira, 25 de maio de 2011 02:36
  • Coloquei o código, porém não funcionou.

    Segu endere~ço com a planilha sugerida

    http://www.megaupload.com/?d=MLR7GSF2

    quinta-feira, 26 de maio de 2011 02:45
  • Escreve na célula F2 a fórmula:

    =StringConcat(", ";SE(C2:E2>0;$C$1:$E$1;""))

    (Fórmula matricial. Pressione Ctrl+Shift+Enter para entrá-la)

    Em seguida, cole em seu módulo o código de Chip Pearson encontrado em:


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Sugerido como Resposta Diego Piffaretti terça-feira, 7 de junho de 2011 15:30
    • Marcado como Resposta rsant sábado, 11 de junho de 2011 09:47
    segunda-feira, 30 de maio de 2011 13:52
  • É meu jovem, fiz o que estava escrito e não funcionou.

     

    Enviei a planilha no link indicado, tem como vc fazer nela e postar?

     

    sexta-feira, 10 de junho de 2011 02:57
  • Não há necessidade de eu postar o arquivo novamente, porque fez tudo certo, mas não pressioneou Ctrl+Shift+Enter para entrar com a fórmula.

    Selecione a célula F2.

    Pressione a tecla F2 (coincidiu o nome da célula com o atalho do teclado, neste caso).

    Pressione Ctrl+Shift+Enter. Você saberá que a fórmula matricial foi entrada corretamente quando ver que na barra de fórmulas há um sinal { antes da fórmula e } após ela.

    Para saber mais sobre fórmulas matriciais, consulte: http://www.ambienteoffice.com.br/excel/formulas_matriciais/


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    sábado, 11 de junho de 2011 02:50
  • Obrigado pela ajuda e principalmente paciência

     

    fui!!

    sábado, 11 de junho de 2011 09:49