Como alinhar valores de coluna com seu valor correspondente em outra coluna?

Question

Tenho várias colunas de dados que preciso alinhar com uma coluna principal.

O seguinte é um exemplo do que espero alcançar, mas com uma tabela contendo mais strings maiores e mais linhas. Os dados em cada linha são exclusivos, aparecendo apenas uma vez. Por isso, apenas pretendo alinhar esses valores únicos nas colunas B, C e D com os de A, que contém a lista completa de cadeias possíveis. Além disso, os valores em cada coluna são classificados, portanto, é o caso de soltar as células até que elas se alinhem com a coluna A, que é o que eu tenho feito manualmente agora, mas quero automatizar:

TenhoexperiêncialimitadacomoExcel,mastodaapesquisamelevouaessecódigoparausaremummódulo.Infelizmentequandoéexecutado,nãofazmuitopormim.Nasegundatentativa,comomelhordeminhashabilidades,tenteiajustarocódigoparaseadequaraointervalodevaloresnaminhaplanilha,masnãoconsigoexecutá-lo.Então,euesperoquemembrosmaisexperientesmeinformemseeurealmenteprecisofazerocódigoseadequaraosmeusdadosousedeveriasimplesmentefuncionar?Obrigadoporqualquerajudaquevocêpodedarousimplesmentetertempoparaler!

OptionExplicitSubAlignCustNbr()'hiker95,01/10/2011'http://www.mrexcel.com/forum/showthread.php?t=520077''Themacrowasmodifiedfromcodeby:'Krishnakumar,12/12/2010'http://www.ozgrid.com/forum/showthread.php?t=148881'DimwsAsWorksheetDimLRAsLong,aAsLongDimCustNbrAsRangeApplication.ScreenUpdating=FalseSetws=Worksheets("Sheet1")
LR = ws.Range("E" & ws.Rows.Count).End(xlUp).Row
    ws.Range("E3:G" & LR).Sort Key1:=ws.Range("E3"), Order1:=xlAscending, Header:=xlNo, _
   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("A3:C" & LR).Sort Key1:=ws.Range("A3"), Order1:=xlAscending, Header:=xlNo, _
   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    Set CustNbr = ws.Range("A2:C" & LR)
    a = 2
    Do While CustNbr.Cells(a, 1) <> ""
    If CustNbr.Cells(a, 1).Offset(, 4) <> "" Then
    If CustNbr.Cells(a, 1) < CustNbr.Cells(a, 1).Offset(, 4) Then
      CustNbr.Cells(a, 1).Offset(, 4).Resize(, 3).Insert -4121
    ElseIf CustNbr.Cells(a, 1) > CustNbr.Cells(a, 1).Offset(, 4) Then
      CustNbr.Cells(a, 1).Resize(, 3).Insert -4121
      LR = LR + 1
      Set CustNbr = ws.Range("A3:C" & LR)
    End If
   End If
  a = a + 1
Loop
Application.ScreenUpdating = 1
End Sub!

    

Answer 1

Eu não sou tão bom em VBA, mas esse código pode fazer isso:

Option Explicit

Public Sub AlignCustNbr()
    Dim ws As Worksheet
    Dim i As Long

    Application.ScreenUpdating = False
    Set ws = ActiveSheet
    For i = 2 To ws.Columns.Count
        If (Trim(ws.Cells(1, i).Value & "") = "") Then
            Exit For
        End If
        '
        Call Align2Columns(ws, 1, i)
    Next i
End Sub

Private Sub Align2Columns(ws As Worksheet, mainCol As Long, dataCol As Long)
    Dim colData() As String
    Dim strTemp As String, strTemp2 As String
    Dim i As Long, j As Long
    Dim lastDataRow As Integer

    ReDim colData(1 To ws.Rows.Count)
    lastDataRow = 1
    '
    'Findeing aligned datas to colData()
    For i = 1 To ws.Rows.Count
        strTemp = Trim(ws.Cells(i, dataCol).Value & "")
        If (strTemp = "") Then
            Exit For
        End If
        '
        For j = 1 To ws.Rows.Count
            strTemp2 = Trim(ws.Cells(j, mainCol).Value & "")
            If (strTemp2 = "") Then
                lastDataRow = lastDataRow + 1
                colData(j + lastDataRow) = strTemp2
                Exit For

            ' to avoid cese sensetive use commented line
            'ElseIf (UCase(strTemp) = UCase(strTemp2)) Then
            ElseIf (strTemp = strTemp2) Then
                colData(j) = strTemp2
                Exit For

            End If
        Next j
    Next i
    '
    'Update dataCol
    i = 0
    Do
        i = i + 1
        ws.Cells(i, dataCol).Value = colData(i)
        If (Trim(ws.Cells(i, mainCol).Value & "") = "") Then
            lastDataRow = lastDataRow - 1
        End If
    Loop While lastDataRow > 0
End Sub