如果单元格中的值符合条件,则从特定列中反转数据选择
Reverse a selection of data from a specific column if value in a cell meets a criteria
我有一个表单,用户可以在其中输入项目名称和交易类型。
我写了一个宏,return根据用户输入的项目名称从 table 中选择数据,而且效果很好。
现在我需要添加一个函数,如果用户输入特定的交易类型,它会反转同一列表的顺序,它会反转同一数据列表的顺序。
例如,如果输入 A returns:
鲍勃
杰瑞
安德鲁
杰夫
然后类型 B 将颠倒该顺序并且 return:
杰夫
安德鲁
杰瑞
鲍勃
我为第一部分写的VBA,到return基于项目名称的列表是:
Sub finddata()
Dim projectName As String
Dim transactionType As String
Dim finalRow As Integer
Dim i As Integer
Sheets("Template_Test").Range("G10:I38").ClearContents
projectName = Sheets("Template_Test").Range("E10").Value
finalRow = Sheets("Project_Structure").Range("A20000").End(xlUp).Row
transactionType = Sheets("Template_Test").Range("E14").Value
For i = 2 To finalRow
Sheets("Project_Structure").Activate
If Cells(i, 1) = projectName Then
Sheets("Project_Structure").Range(Cells(i, 2), Cells(i, 4)).Copy
Sheets("Template_Test").Activate
Sheets("Template_Test").Range("G100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
End If
Next i
Sheets("Template_Test").Range("E10").Select
End Sub
我可以使用内置的 vba 函数 strReverse 和特定范围来反转顺序选择,但我的数据不是一致的单元格长度 - 有时是 6 个名称,有时是 15 个 - 并且我无法弄清楚如何在不包括范围下方的空白单元格的情况下调整它需要反转的长度。
这里是使用ArrayList
对象
的.Reverse
方法的方法
Option Explicit
Public Sub ReverseAList()
Dim ws As Worksheet, arr(), i As Long, aList As Object, lastRow As Long
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set aList = CreateObject("System.Collections.ArrayList")
With ws
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'whichever column is required to determine last row. Assumes there are headers in row1
If lastRow = 2 Then arr(0) = .Range("A2").Value
arr = .Range("A2:A" & lastRow).Value
For i = LBound(arr, 1) To UBound(arr, 1)
aList.Add arr(i, 1)
Next i
aList.Reverse
For i = 0 To aList.Count - 1
arr(i + 1, 1) = aList(i)
Next
.Cells(2, 2).Resize(aList.Count, 1) = arr
End With
End Sub
数据和输出
同样的事情将 Ryan Wells 的 sub 重写为一个函数:
Public Sub ReverseAList2()
Dim ws As Worksheet, arr(), i As Long, aList As Object, lastRow As Long
Set ws = ThisWorkbook.Worksheets("Sheet1")
With ws
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'whichever column is required to determine last row. Assumes there are headers in row1
If lastRow = 2 Then arr(0) = .Range("A2").Value
arr = .Range("A2:A" & lastRow).Value
.Cells(2, 2).Resize(UBound(arr), 1) = ReverseArray(arr)
End With
End Sub
Public Function ReverseArray(vArray As Variant) As Variant
Dim vTemp As Variant, i As Long, iUpper As Long, iMidPt As Long
iUpper = UBound(vArray, 1)
iMidPt = (UBound(vArray, 1) - LBound(vArray, 1)) \ 2 + LBound(vArray)
For i = LBound(vArray) To iMidPt
vTemp = vArray(iUpper, 1)
vArray(iUpper, 1) = vArray(i, 1)
vArray(i, 1) = vTemp
iUpper = iUpper - 1
Next i
ReverseArray = vArray
End Function
我有一个表单,用户可以在其中输入项目名称和交易类型。
我写了一个宏,return根据用户输入的项目名称从 table 中选择数据,而且效果很好。
现在我需要添加一个函数,如果用户输入特定的交易类型,它会反转同一列表的顺序,它会反转同一数据列表的顺序。
例如,如果输入 A returns:
鲍勃
杰瑞
安德鲁
杰夫
然后类型 B 将颠倒该顺序并且 return:
杰夫
安德鲁
杰瑞
鲍勃
我为第一部分写的VBA,到return基于项目名称的列表是:
Sub finddata()
Dim projectName As String
Dim transactionType As String
Dim finalRow As Integer
Dim i As Integer
Sheets("Template_Test").Range("G10:I38").ClearContents
projectName = Sheets("Template_Test").Range("E10").Value
finalRow = Sheets("Project_Structure").Range("A20000").End(xlUp).Row
transactionType = Sheets("Template_Test").Range("E14").Value
For i = 2 To finalRow
Sheets("Project_Structure").Activate
If Cells(i, 1) = projectName Then
Sheets("Project_Structure").Range(Cells(i, 2), Cells(i, 4)).Copy
Sheets("Template_Test").Activate
Sheets("Template_Test").Range("G100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
End If
Next i
Sheets("Template_Test").Range("E10").Select
End Sub
我可以使用内置的 vba 函数 strReverse 和特定范围来反转顺序选择,但我的数据不是一致的单元格长度 - 有时是 6 个名称,有时是 15 个 - 并且我无法弄清楚如何在不包括范围下方的空白单元格的情况下调整它需要反转的长度。
这里是使用ArrayList
对象
.Reverse
方法的方法
Option Explicit
Public Sub ReverseAList()
Dim ws As Worksheet, arr(), i As Long, aList As Object, lastRow As Long
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set aList = CreateObject("System.Collections.ArrayList")
With ws
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'whichever column is required to determine last row. Assumes there are headers in row1
If lastRow = 2 Then arr(0) = .Range("A2").Value
arr = .Range("A2:A" & lastRow).Value
For i = LBound(arr, 1) To UBound(arr, 1)
aList.Add arr(i, 1)
Next i
aList.Reverse
For i = 0 To aList.Count - 1
arr(i + 1, 1) = aList(i)
Next
.Cells(2, 2).Resize(aList.Count, 1) = arr
End With
End Sub
数据和输出
同样的事情将 Ryan Wells 的 sub 重写为一个函数:
Public Sub ReverseAList2()
Dim ws As Worksheet, arr(), i As Long, aList As Object, lastRow As Long
Set ws = ThisWorkbook.Worksheets("Sheet1")
With ws
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'whichever column is required to determine last row. Assumes there are headers in row1
If lastRow = 2 Then arr(0) = .Range("A2").Value
arr = .Range("A2:A" & lastRow).Value
.Cells(2, 2).Resize(UBound(arr), 1) = ReverseArray(arr)
End With
End Sub
Public Function ReverseArray(vArray As Variant) As Variant
Dim vTemp As Variant, i As Long, iUpper As Long, iMidPt As Long
iUpper = UBound(vArray, 1)
iMidPt = (UBound(vArray, 1) - LBound(vArray, 1)) \ 2 + LBound(vArray)
For i = LBound(vArray) To iMidPt
vTemp = vArray(iUpper, 1)
vArray(iUpper, 1) = vArray(i, 1)
vArray(i, 1) = vTemp
iUpper = iUpper - 1
Next i
ReverseArray = vArray
End Function