Bagaimana cara menyelaraskan nilai kolom dengan nilai yang cocok di kolom lain?

Saya memiliki beberapa kolom data yang perlu saya selaraskan dengan kolom master.

Berikut ini adalah contoh dari apa yang ingin saya capai, tetapi dengan tabel berisi string yang lebih besar dan lebih banyak baris. Data di setiap baris unik, hanya muncul sekali. Jadi saya hanya bertujuan untuk menyelaraskan nilai-nilai unik di kolom B, C dan D dengan nilai A yang berisi daftar lengkap dari string yang mungkin. Juga nilai-nilai di setiap kolom diurutkan, jadi ini adalah kasus menabrak sel sampai mereka sejajar dengan Kolom A, yang telah saya lakukan secara manual untuk saat ini tetapi ingin mengotomatisasi:

Contoh tangkapan layar

Saya memiliki pengalaman terbatas dengan Excel, tetapi semua penelitian telah mengarahkan saya ke kode ini untuk digunakan dalam modul. Sayangnya ketika dijalankan, itu tidak banyak membantu saya. Pada upaya kedua, untuk yang terbaik dari kemampuan saya, saya mencoba menyesuaikan kode agar sesuai dengan rentang nilai di lembar saya tetapi saya tidak bisa menjalankannya. Jadi saya berharap jika anggota yang lebih berpengalaman memberi tahu saya jika saya benar-benar perlu membuat kode sesuai dengan data saya atau hanya berfungsi? Terima kasih atas bantuan yang dapat Anda berikan atau luangkan waktu untuk membaca!

Option Explicit
Sub AlignCustNbr()
' hiker95, 01/10/2011
' http://www.mrexcel.com/forum/showthread.php?t=520077
'
' The macro was modified from code by:
' Krishnakumar, 12/12/2010
' http://www.ozgrid.com/forum/showthread.php?t=148881
'
Dim ws As Worksheet
Dim LR As Long, a As Long
Dim CustNbr As Range
Application.ScreenUpdating = False
Set ws = 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!

microsoft-excel-2010 macros alignment

— OreoRyan
sumber

Apakah tangkapan layar itu contoh dari input dan output yang diharapkan, atau hasil dari kode Anda? Jika itu bukan contoh hasil yang diharapkan, harap tambahkan (termasuk kasus tepi, seperti: apakah nilai dalam input unik, dan diurutkan?), Untuk menjelaskan apa "beberapa kolom data yang perlu saya selaraskan dengan kolom master " artinya.

— Arjan

@Arjan Hai, maaf. Saya akan mengklarifikasi lebih lanjut. Contohnya hanyalah contoh. Ini bukan hasil dari kode. Hanya apa yang saya harapkan untuk dicapai, tetapi dengan sebuah tabel yang berisi string yang lebih besar dan lebih banyak baris. Informasi lebih lanjut adalah bahwa data di setiap baris adalah unik, hanya muncul sekali. Jadi saya hanya bertujuan untuk menyelaraskan nilai-nilai unik di kolom B, C dan D dengan nilai A yang berisi daftar lengkap dari string yang mungkin. Juga nilai-nilai di setiap kolom diurutkan, jadi ini adalah kasus menabrak sel sampai mereka sejajar dengan Kolom A, yang telah saya lakukan secara manual untuk saat ini tetapi ingin mengotomatisasi.

— OreoRyan

Tidak perlu makro, kecuali Anda benar-benar tidak ingin kolom tambahan. Aku akan melihat ke dalam VLOOKUPrumus dan menggunakan kolom tambahan (atau lembar kerja yang terpisah) untuk hasilnya.

— Arjan

Adapun "Juga nilai-nilai di setiap kolom diurutkan" : itu tidak benar dalam contoh Anda ...? (Tapi bukan masalah bagi VLOOKUP, ketika parameter ke-4 adalah FALSE.)

— Arjan

Saya tidak begitu bagus di VBA tetapi kode ini bisa melakukan itu:

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

— shA.t
sumber