筛选复制粘贴到相应表格 相应位置

lengyifei

Private Sub CommandButton13_Click()

   '办公用房
Dim ws1 As Worksheet '其他类型房产销售统计
Dim ws2 As Worksheet '销售明细底稿
Dim lastRow As Long '销售明细底稿最后一行的行号
Dim copyRange As Range '销售明细底稿的B、C和E列数据连接结果
Dim pasteRange As Range '其他类型房产销售统计的B、C和D列数据
Dim filterCriteria As String '筛选条件
Dim bColumnValues As Variant '销售明细底稿的B列数据
Dim startRow As Long '符合筛选条件的第一行

'设置工作表对象
Set ws1 = ThisWorkbook.Worksheets("其他类型房产销售统计")
Set ws2 = ThisWorkbook.Worksheets("销售明细底稿")

'找到销售明细底稿最后一行的行号
lastRow = ws2.Cells(Rows.Count, "B").End(xlUp).Row

'复制销售明细底稿的B列数据
bColumnValues = ws2.Range("B4:B" & lastRow).Value

'筛选销售明细底稿的G列，选择 "办公用房"
filterCriteria = "办公用房"
startRow = 4 '起始行为1
Do While ws2.Cells(startRow, "G").Value <> filterCriteria And startRow <= lastRow
    startRow = startRow + 1
Loop
If startRow > lastRow Then Exit Sub '如果没有符合条件的行，则退出子过程
ws2.Range("G4:G" & lastRow).AutoFilter Field:=1, Criteria1:=filterCriteria


'将筛选后的B、C和E列的数据连接在一起，用"-"连接，然后复制到普通住宅销售统计的B列
Set copyRange = Nothing
On Error Resume Next
Set copyRange = ws2.Range("B" & startRow & ":B" & lastRow).SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Not copyRange Is Nothing Then
   Dim copyValues() As String
Dim i As Long
ReDim copyValues(1 To copyRange.Cells.Count, 1 To 1)
For i = 1 To copyRange.Cells.Count
    copyValues(i, 1) = copyRange.Cells(i).Value & "-" & ws2.Cells(copyRange.Cells(i, 1).Row, "C").Value & "-" & ws2.Cells(copyRange.Cells(i, 1).Row, "E").Value
Next i
    Set pasteRange = ws1.Range("B4:B" & lastRow + 1)
    pasteRange.Resize(UBound(copyValues, 1), 1).Value = copyValues
End If

'将销售明细底稿的B列数据粘贴回去
ws2.Range("B4:B" & lastRow).Value = bColumnValues

'将筛选后的M、P和U列的数据复制到普通住宅销售统计的C、D和F列
Set copyRange = ws2.Range("M" & startRow & ":M" & lastRow).Cells.SpecialCells(xlCellTypeVisible)
Set pasteRange = ws1.Range("C4:C" & lastRow + 1)
pasteRange.Resize(UBound(copyValues, 1), 1).Value = copyRange.Value

Set copyRange = ws2.Range("P" & startRow & ":P" & lastRow).Cells.SpecialCells(xlCellTypeVisible)
Set pasteRange = ws1.Range("D4:D" & lastRow + 1)
pasteRange.Resize(UBound(copyValues, 1), 1).Value = copyRange.Value

Set copyRange = ws2.Range("U" & startRow & ":U" & lastRow).Cells.SpecialCells(xlCellTypeVisible)
Set pasteRange = ws1.Range("F4:F" & lastRow + 1)
pasteRange.Resize(UBound(copyValues, 1), 1).Value = copyRange.Value

'取消筛选
ws2.AutoFilterMode = False




End Sub


求解：多谢各位大神。



这个是我的代码，现在[color=rgba(0, 0, 0, 0.87)]他筛选后只能复制相邻的，比如说我筛选后数据在 2、3、4、8行，他计算的行数是正确的的 一共四行，但复制的时候 复制的是 第2、3、4、5行的数据 复制了四行正确 但 不相邻的第八行 没复制上 ；；；如果筛选后在2、4、6、8行，那么他复制的内容是第2、3、4、5行的内容 这个那个地方用错了？？？

lengyifei

而且后面的列  只复制了第一行  复制了四遍

吴中泉

能写出如此复杂的代码，也应该能找出错误原因

lengyifei

Private Sub CommandButton1_Click()


   '办公用房
Dim ws1 As Worksheet '其他类型房产销售统计
Dim ws2 As Worksheet '销售明细底稿
Dim lastRow As Long '销售明细底稿最后一行的行号
Dim copyRange As Range '销售明细底稿的B、C和E列数据连接结果
Dim pasteRange As Range '其他类型房产销售统计的B、C和e列数据
Dim filterCriteria As String '筛选条件
Dim startRow As Long '符合筛选条件的第一行
Dim n As Integer

'设置工作表对象
Set ws1 = ThisWorkbook.Worksheets("其他类型房产销售统计")
Set ws2 = ThisWorkbook.Worksheets("销售明细底稿")

'找到销售明细底稿最后一行的行号
lastRow = ws2.Cells(Rows.Count, "B").End(xlUp).Row
n = ThisWorkbook.Worksheets("销售明细底稿").Range("L263").Value


'筛选销售明细底稿的G列，选择 "办公用房"
filterCriteria = "办公用房"
startRow = 4 '起始行为4
Do While ws2.Cells(startRow, "G").Value <> filterCriteria And startRow <= lastRow
    startRow = startRow + 1
Loop
If startRow > lastRow Then Exit Sub '如果没有符合条件的行，则退出子过程
ws2.Range("G4:G" & lastRow).AutoFilter Field:=1, Criteria1:=filterCriteria


'将筛选后的B、C和E列的数据连接在一起，用"-"连接，然后复制到普通住宅销售统计的B列

Set copyRange = ws2.Range("B" & startRow & ":U" & lastRow).SpecialCells(xlCellTypeVisible)
Set pasteRange = ws1.Range("B4:B" & lastRow)
Dim i As Long
For i = 1 To n
    Set pasteRange = ws1.Range("B4:B" & lastRow)
    pasteRange.Cells(i, 1).Value = copyRange.Cells(i, 1).Value & "-" & copyRange.Cells(i, 2).Value & "-" & copyRange.Cells(i, 4).Value
Set pasteRange = ws1.Range("C4:C" & lastRow)
pasteRange.Cells(i, 1).Value = copyRange.Cells(i, 12).Value
Set pasteRange = ws1.Range("D4:D" & lastRow)
pasteRange.Cells(i, 1).Value = copyRange.Cells(i, 15).Value
Set pasteRange = ws1.Range("F4:F" & lastRow + 1)
pasteRange.Cells(i, 1).Value = copyRange.Cells(i, 20).Value
Next i
   
   
'取消筛选
ws2.AutoFilterMode = False

  
   
  



End Sub

lengyifei

为什么复制的不是筛选后的行，而是筛选值第一行跟着相邻的行？

lengyifei

正在学习中，好多对象 方法  不会用   ，其实  筛选复制  可以用最简单的 copy  解决