使用vba,把一个excel表中内容为“收益井”的行选择出来,填充到一个新的sheet中
时间: 2023-05-11 15:03:22 浏览: 52
可以使用以下代码实现:
Sub CopyRows()
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim lastRow As Long
Dim i As Long
Set wsSource = ThisWorkbook.Sheets("Sheet1") '修改为你的源表名称
Set wsTarget = ThisWorkbook.Sheets.Add '创建一个新的工作表
wsTarget.Name = "收益井" '修改为你想要的工作表名称
lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row '获取源表最后一行的行号
For i = 1 To lastRow
If wsSource.Cells(i, "A").Value = "收益井" Then '判断是否为“收益井”行
wsSource.Rows(i).Copy wsTarget.Rows(wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row + 1) '将该行复制到新工作表中
End If
Next i
End Sub
这段代码会将源表中所有内容为“收益井”的行复制到一个新的工作表中。
相关问题
使用vba,把一个excel表中内容为“收益井”的行挑出来并重新排序
你可以使用以下代码来实现这个功能:
Sub SortRows()
Dim lastRow As Long
Dim i As Long
Dim j As Long
Dim temp As Variant
lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To lastRow
If ActiveSheet.Cells(i, "A").Value = "收益井" Then
For j = i + 1 To lastRow
If ActiveSheet.Cells(j, "A").Value <> "收益井" Then
temp = ActiveSheet.Rows(j).Value
ActiveSheet.Rows(j).Value = ActiveSheet.Rows(i).Value
ActiveSheet.Rows(i).Value = temp
Exit For
End If
Next j
End If
Next i
End Sub
这段代码会遍历整个表格,找到内容为“收益井”的行,并将它们按照顺序排列在一起。
使用vba,把一个excel表中,具有相同内容的行挑出来并重新排序
可以使用VBA中的循环和条件语句来实现这个功能。具体步骤如下:
1. 定义一个数组,用于存储具有相同内容的行的行号。
2. 循环遍历每一行,比较当前行的内容是否与之前的行相同,如果相同则将当前行的行号添加到数组中。
3. 对数组进行排序,可以使用VBA中的Sort函数。
4. 根据排序后的数组,将相同内容的行按照指定顺序重新排列。
下面是一个示例代码:
Sub SortSameRows()
Dim rowNums() As Long
Dim lastRow As Long
Dim i As Long, j As Long, k As Long
lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ReDim rowNums(1 To lastRow)
k = 1
For i = 1 To lastRow
If i = 1 Or ActiveSheet.Cells(i, 1).Value <> ActiveSheet.Cells(i - 1, 1).Value Then
rowNums(k) = i
k = k + 1
End If
Next i
ReDim Preserve rowNums(1 To k - 1)
If UBound(rowNums) > 1 Then
Call QuickSort(rowNums, LBound(rowNums), UBound(rowNums))
End If
For i = 1 To UBound(rowNums)
For j = i + 1 To UBound(rowNums)
If ActiveSheet.Cells(rowNums(i), 1).Value > ActiveSheet.Cells(rowNums(j), 1).Value Then
Call Swap(rowNums(i), rowNums(j))
End If
Next j
Next i
For i = 1 To UBound(rowNums)
If rowNums(i) <> i Then
ActiveSheet.Rows(rowNums(i)).Cut
ActiveSheet.Rows(i).Insert Shift:=xlDown
End If
Next i
End Sub
Sub QuickSort(arr() As Long, left As Long, right As Long)
Dim i As Long, j As Long
Dim pivot As Long
i = left
j = right
pivot = arr((left + right) \ 2)
Do While i <= j
Do While arr(i) < pivot
i = i + 1
Loop
Do While arr(j) > pivot
j = j - 1
Loop
If i <= j Then
Call Swap(arr(i), arr(j))
i = i + 1
j = j - 1
End If
Loop
If left < j Then
Call QuickSort(arr, left, j)
End If
If i < right Then
Call QuickSort(arr, i, right)
End If
End Sub
Sub Swap(ByRef a As Long, ByRef b As Long)
Dim temp As Long
temp = a
a = b
b = temp
End Sub