Question

我试图复制工作表中的A列中的所有值＆＃34; Output_Setup＆＃34;到＆＃34;输出＆＃34;中的B列价值不是＆＃34;＆＃34;。

这就是我目前的情况：

Sub Copy()
    Sheets("Output_Setup").Range("A1:A15000").Copy
    ActiveWorkbook.Sheets("Output").Range("B3:B15002").PasteSpecial SkipBlanks:=True, Paste:=xlValues
End Sub

在Output_Setup中，大多数单元都有＆＃34;＆＃34;并且只有几百个具有实际价值，基本上我想要＆＃34;＆＃34;在输出工作表上过滤掉但我无法使用简单的过滤器，因为我将使用这些值进行索引/匹配选择。

非常感谢任何帮助。

感谢。

Answer 1

除非输出顺序很重要，否则您可以对输出表中的B列进行排序，使空白被强制到底部。

警告！未经编码的代码！

Sub Copy()
    Sheets("Output_Setup").Range("A1:A15000").Copy
    ActiveWorkbook.Sheets("Output").Range("B3:B15002").PasteSpecial SkipBlanks:=True, Paste:=xlValues

    Sheets("Output").Range("B3.B15002").select

    ActiveWorkbook.Worksheets("Output").Sort.SortFields.Add Key:=Range("B3"), _
    Order:=xlAscending, DataOption:=xlSortTextAsNumbers

    ActiveWorkbook.Worksheets("Output").Sort.Apply

End Sub

Answer 2

这里最好的选择是一个决定是否复制值的循环。请尝试以下方法：

    Sub CopyValues()
    application.screenupdating = false 'will speed up process

    Dim TheOutSheet as Worksheet
    Dim TheInSheet as Worksheet
    Dim outRow as long
    Dim inRow as long
    inRow = 1
    Set TheOutSheet = Sheets("The sheet name you want to pull values from") 'make sure you use quotes
    Set TheInSheet = Sheets("Sheet to put values into")

    For outRow = 1 to 15000 '<- this number can be your last row that has a real value, the higher the number the longer the loop.
      If TheOutSheet.Cells(outRow,1).value <> "" then
          TheInSheet.Cells(inRow,1).value = TheOutSheet.Cells(outRow,1).value
          inRow = inRow + 1
      end if
    Next
    application.screenupdating = True
    End Sub

将您的具体值放在需要的位置（我注意到了这些区域）并尝试一下。如果它不起作用，请告诉我它出错的地方。

Answer 3

您可以使用SpecialCells一次性删除空白而不循环

Sub Copy()
    Sheets("Output_Setup").Range("A1:A15000").Copy
    With Sheets("Output").Range("B3:B15002")
    .PasteSpecial , Paste:=xlValues
    On Error Resume Next
    .SpecialCells(xlBlanks).Delete xlUp
    On Error GoTo 0
    End With
End Sub

Answer 4

您必须单独循环以清除“”单元格。测试代码如下：

Sub foo()
    Sheets("Sheet1").Range("A1:A15000").Copy
    Sheets("Sheet2").Range("A1:A15000").PasteSpecial xlPasteValues

    Dim x As Range
    For Each x In Sheets("Sheet2").Range("A1:A15000")
        If Not IsEmpty(x) Then
            If x.Value = "" Then
                x.ClearContents
            End If
        End If
    Next x
End Sub

Answer 5

您要做的是复制除零长度字符串""以外的值吗？这可能有效：

With Thisworkbook.Sheets("Output_Setup")
    .AutoFilterMode = False
    With .Range("A1:A15000")
        .AutoFilter Field:= 1, Criteria1:= "<>"
        .SpecialCells(xlCellTypeVisible).Copy
        Thisworkbook.Sheets("Output").Range("B3").PasteSpecial xlPasteValues
    End With
    .AutoFilterMode = False
End With

未经测试，所以我将测试留给您希望这对你有所帮助。

使用vba将值从一个工作表复制到另一个工作表

5 个答案: