![如何将列值与另一列中的匹配值对齐?](https://linux22.com/image/1441583/%E5%A6%82%E4%BD%95%E5%B0%86%E5%88%97%E5%80%BC%E4%B8%8E%E5%8F%A6%E4%B8%80%E5%88%97%E4%B8%AD%E7%9A%84%E5%8C%B9%E9%85%8D%E5%80%BC%E5%AF%B9%E9%BD%90%EF%BC%9F.png)
我有几列数据需要与主列对齐。
以下是我希望实现的示例,但表格中包含更多更大的字符串和更多行。每行中的数据都是唯一的,仅出现一次。因此,我只想将 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