☰

如何将列值与另一列中的匹配值对齐？

tag-icon • tag-icon microsoft-excel-2010 macros alignment
如何将列值与另一列中的匹配值对齐？

我有几列数据需要与主列对齐。

以下是我希望实现的示例，但表格中包含更多更大的字符串和更多行。每行中的数据都是唯一的，仅出现一次。因此，我只想将 B、C 和 D 列中的唯一值与包含可能字符串完整列表的 A 列的值对齐。此外，每列中的值都经过排序，因此需要将单元格向下移动，直到它们与 A 列对齐，这是我目前手动执行的操作，但希望实现自动化：

示例截图

我对 Excel 的经验有限，但所有的研究都让我找到了这个代码，可以在模块中使用。不幸的是，当它运行时，它对我没什么用。第二次尝试时，我尽我所能调整代码以适应工作表中的值范围，但我无法让它运行。所以我希望更有经验的成员能告诉我，我是否真的需要让代码适合我的数据，或者它应该可以正常工作？感谢您提供的任何帮助，或者只是花时间阅读！

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!

答案1

我不太擅长 VBA，但这段代码可以做到这一点：

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

相关内容